source: 2.19_branch/Sibyl/SPCC/FILECTRL.PAS@ 376

Last change on this file since 376 was 7, checked in by RBRi, 19 years ago

+ sibyl staff
  • Property svn:eol-style set to native
File size: 34.9 KB
Line 
1
2{ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
3 º º
4 º Sibyl Portable Component Classes º
5 º º
6 º Copyright (C) 1995,97 SpeedSoft Germany, All rights reserved. º
7 º º
8 ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ}
9
10Unit FileCtrl;
11
12Interface
13
14Uses Dos,SysUtils,Classes,Forms,StdCtrls;
15
16
17Type
18 TDirectoryListBox=Class;
19 TDriveComboBox=Class;
20 TFilterComboBox=Class;
21
22
23 {ftVolumnID has no effect, but exists For compatibility Of TFileAttr}
24 TFileAttr=(ftReadOnly,ftHidden,ftSystem,ftVolumeID,ftDirectory,ftArchive,
25 ftNormal);
26 TFileType=Set Of TFileAttr;
27
28 TFileListBox=Class(TListBox)
29 Private
30 FMask:String;
31 FOldMask:String;
32 FDirectory:String;
33 FOldDirectory:String;
34 FFileType:TFileType;
35 FOldFileType:TFileType;
36 FFileEdit:TEdit;
37 FDirList:TDirectoryListBox;
38 FFilterCombo:TFilterComboBox;
39 FOnChange:TNotifyEvent;
40 Function GetDrive:Char;
41 Procedure SetDrive(NewDrive:Char);
42 Procedure SetDirectory(NewDir:String);
43 Procedure SetFileName(NewFile:String);
44 Function GetFileName:String;
45 Procedure SetMask(NewMask:String);
46 Procedure SetFileType(Attr:TFileType);
47 Procedure SetFileEdit(NewEdit:TEdit);
48 Procedure BuildList;
49 Protected
50 Procedure SetupComponent;Override;
51 Procedure Notification(AComponent:TComponent;Operation:TOperation);Override;
52 Procedure ItemFocus(Index:LongInt);Override;
53 Procedure Change;Virtual;
54 Property Duplicates;
55 Property Sorted;
56 Procedure SetupShow;Override;
57 Public
58 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
59 Property FileName:String Read GetFileName Write SetFileName;
60 Property Directory:String Read FDirectory Write SetDirectory;
61 Property Drive:Char Read GetDrive Write SetDrive;
62 Property Items;
63 Property XAlign;
64 Property XStretch;
65 Property YAlign;
66 Property YStretch;
67 Published
68 Property Align;
69 Property Color;
70 Property PenColor;
71 Property DragCursor;
72 Property DragMode;
73 Property Enabled;
74 Property ExtendedSelect;
75 Property FileEdit:TEdit Read FFileEdit Write SetFileEdit;
76 Property FileType:TFileType Read FFileType Write SetFileType;
77 Property Font;
78 Property HorzScroll;
79 Property IntegralHeight;
80 Property ItemHeight;
81 Property Mask:String Read fMask Write SetMask;
82 Property MultiSelect;
83 Property ParentColor;
84 Property ParentPenColor;
85 Property ParentFont;
86 Property ParentShowHint;
87 Property ShowDragRects;
88 Property ShowHint;
89 Property Style;
90 Property TabOrder;
91 Property TabStop;
92 Property Visible;
93 Property ZOrder;
94
95 Property OnCanDrag;
96 Property OnChange:TNotifyEvent Read FOnChange Write FOnChange;
97 Property OnDragDrop;
98 Property OnDragOver;
99 Property OnDrawItem;
100 Property OnEndDrag;
101 Property OnEnter;
102 Property OnExit;
103 Property OnFontChange;
104 Property OnKeyPress;
105 Property OnMeasureItem;
106 Property OnMouseClick;
107 Property OnMouseDblClick;
108 Property OnMouseDown;
109 Property OnMouseMove;
110 Property OnMouseUp;
111 Property OnScan;
112 Property OnSetupShow;
113 Property OnStartDrag;
114 End;
115
116
117 TDirectoryListBox=Class(TListBox)
118 Private
119 FDirectory:String;
120 FOldDirectory:String;
121 FDirLabel:TLabel;
122 FFileList:TFileListBox;
123 FDriveCombo:TDriveComboBox;
124 FOnChange:TNotifyEvent;
125 Procedure SetDirectory(NewDir:String);
126 Function GetDrive:Char;
127 Procedure SetDrive(NewDrive:Char);
128 Procedure SetDirLabel(ALabel:TLabel);
129 Procedure SetFileListBox(AFileList:TFileListBox);
130 Procedure BuildList;
131 Protected
132 Procedure SetupComponent;Override;
133 Procedure Notification(AComponent:TComponent;Operation:TOperation);Override;
134 Procedure ItemSelect(Index:LongInt);Override;
135 Procedure Change;Virtual;
136 Procedure DrawOpenFolder(X,Y:LongInt);
137 Procedure DrawClosedFolder(X,Y:LongInt);
138 Procedure MeasureItem(Index:LongInt;Var Width,Height:LongInt);Override;
139 Procedure DrawItem(Index:LongInt;rec:TRect;State:TOwnerDrawState);Override;
140 Procedure SetupShow;Override;
141 Property Duplicates;
142 Property ExtendedSelect;
143 Property ItemHeight;
144 Property MultiSelect;
145 Property Sorted;
146 Property Style;
147 Property OnDrawItem;
148 Property OnMeasureItem;
149 Public
150 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
151 Property Directory:String Read FDirectory Write SetDirectory;
152 Property Drive:Char Read GetDrive Write SetDrive;
153 Property Items;
154 Property XAlign;
155 Property XStretch;
156 Property YAlign;
157 Property YStretch;
158 Published
159 Property Align;
160 Property Color;
161 Property PenColor;
162 Property DirLabel:TLabel Read FDirLabel Write SetDirLabel;
163 Property DragCursor;
164 Property DragMode;
165 Property Enabled;
166 Property FileList:TFileListBox Read FFileList Write SetFileListBox;
167 Property Font;
168 Property HorzScroll;
169 Property IntegralHeight;
170 Property ParentColor;
171 Property ParentPenColor;
172 Property ParentFont;
173 Property ParentShowHint;
174 Property ShowDragRects;
175 Property ShowHint;
176 Property TabOrder;
177 Property TabStop;
178 Property Visible;
179 Property ZOrder;
180
181 Property OnCanDrag;
182 Property OnChange:TNotifyEvent Read FOnChange Write FOnChange;
183 Property OnDragDrop;
184 Property OnDragOver;
185 Property OnEndDrag;
186 Property OnEnter;
187 Property OnExit;
188 Property OnFontChange;
189 Property OnKeyPress;
190 Property OnMouseClick;
191 Property OnMouseDblClick;
192 Property OnMouseDown;
193 Property OnMouseMove;
194 Property OnMouseUp;
195 Property OnScan;
196 Property OnSetupShow;
197 Property OnStartDrag;
198 End;
199
200
201 {$HINTS OFF}
202 TDriveComboBox=Class(TComboBox)
203 Private
204 FDrive:Char;
205 FDirList:TDirectoryListBox;
206 FOnChange:TNotifyEvent;
207 Procedure SetDrive(NewDrive:Char);
208 Procedure SetDirListBox(ADirList:TDirectoryListBox);
209 Protected
210 Procedure SetupComponent;Override;
211 Procedure Notification(AComponent:TComponent;Operation:TOperation);Override;
212 Procedure ItemSelect(Index:LongInt);Override;
213 Procedure Change;Virtual;
214 Property Duplicates;
215 Property MaxLength;
216 Property SelLength;
217 Property SelStart;
218 Property SelText;
219 Property Sorted;
220 Property Style;
221 Property TextExtension;
222 Public
223 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
224 Property Drive:Char Read FDrive Write SetDrive;
225 Property Items;
226 Property Text;
227 Property XAlign;
228 Property XStretch;
229 Property YAlign;
230 Property YStretch;
231 Published
232 Property Align;
233 Property Color;
234 Property PenColor;
235 Property DirList:TDirectoryListBox Read FDirList Write SetDirListBox;
236 Property DragCursor;
237 Property DragMode;
238 Property DropDownCount;
239 Property Enabled;
240 Property Font;
241 Property ParentColor;
242 Property ParentPenColor;
243 Property ParentFont;
244 Property ParentShowHint;
245 Property ShowHint;
246 Property TabOrder;
247 Property TabStop;
248 Property Visible;
249 Property ZOrder;
250
251 Property OnCanDrag;
252 Property OnChange:TNotifyEvent Read FOnChange Write FOnChange;
253 Property OnDragDrop;
254 Property OnDragOver;
255 Property OnDropDown;
256 Property OnEndDrag;
257 Property OnEnter;
258 Property OnExit;
259 Property OnFontChange;
260 Property OnKeyPress;
261 Property OnMouseClick;
262 Property OnMouseDblClick;
263 Property OnMouseDown;
264 Property OnMouseMove;
265 Property OnMouseUp;
266 Property OnScan;
267 Property OnSetupShow;
268 Property OnStartDrag;
269 End;
270 {$HINTS ON}
271
272
273 {$HINTS OFF}
274 TFilterComboBox=Class(TComboBox)
275 Private
276 FFilter:String;
277 FFileList:TFileListBox;
278 FMaskList:TStringList;
279 FOnChange:TNotifyEvent;
280 Procedure SetFilter(NewFilter:String);
281 Procedure SetFileListBox(AFileList:TFileListBox);
282 Function GetMask:String;
283 Procedure BuildList;
284 Protected
285 Procedure SetupComponent;Override;
286 Procedure Notification(AComponent:TComponent;Operation:TOperation);Override;
287 Procedure SetupShow;Override;
288 Procedure ItemSelect(Index:LongInt);Override;
289 Procedure Change;Virtual;
290 Property Duplicates;
291 Property Mask:String Read GetMask;
292 Property MaxLength;
293 Property SelLength;
294 Property SelStart;
295 Property SelText;
296 Property Sorted;
297 Property Style;
298 Property TextExtension;
299 Public
300 Destructor Destroy;Override;
301 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
302 Property Items;
303 Property Text;
304 Property XAlign;
305 Property XStretch;
306 Property YAlign;
307 Property YStretch;
308 Published
309 Property Align;
310 Property Color;
311 Property PenColor;
312 Property DragCursor;
313 Property DragMode;
314 Property DropDownCount;
315 Property Enabled;
316 Property FileList:TFileListBox Read FFileList Write SetFileListBox;
317 Property Filter:String Read FFilter Write SetFilter;
318 Property Font;
319 Property ParentColor;
320 Property ParentPenColor;
321 Property ParentFont;
322 Property ParentShowHint;
323 Property ShowHint;
324 Property TabOrder;
325 Property TabStop;
326 Property Visible;
327 Property ZOrder;
328
329 Property OnCanDrag;
330 Property OnChange:TNotifyEvent Read FOnChange Write FOnChange;
331 Property OnDragDrop;
332 Property OnDragOver;
333 Property OnDropDown;
334 Property OnEndDrag;
335 Property OnEnter;
336 Property OnExit;
337 Property OnFontChange;
338 Property OnKeyPress;
339 Property OnMouseClick;
340 Property OnMouseDblClick;
341 Property OnMouseDown;
342 Property OnMouseMove;
343 Property OnMouseUp;
344 Property OnScan;
345 Property OnSetupShow;
346 Property OnStartDrag;
347 End;
348 {$HINTS ON}
349
350
351
352Function InsertFileListBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TFileListBox;
353Function InsertDirectoryListBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TDirectoryListBox;
354Function InsertDriveComboBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TDriveComboBox;
355Function InsertFilterComboBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TFilterComboBox;
356
357
358Implementation
359
360{$IFDEF OS2}
361Uses BseDos;
362{$ENDIF}
363
364{$IFDEF Win95}
365Uses WinBase;
366{$ENDIF}
367
368
369Function InsertFileListBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TFileListBox;
370Begin
371 Result.Create(parent);
372 Result.SetWindowPos(Left,Bottom,Width,Height);
373 Result.parent := parent;
374End;
375
376
377Function InsertDirectoryListBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TDirectoryListBox;
378Begin
379 Result.Create(parent);
380 Result.SetWindowPos(Left,Bottom,Width,Height);
381 Result.parent := parent;
382End;
383
384
385Function InsertDriveComboBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TDriveComboBox;
386Begin
387 Result.Create(parent);
388 Result.SetWindowPos(Left,Bottom,Width,Height);
389 Result.parent := parent;
390End;
391
392
393Function InsertFilterComboBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TFilterComboBox;
394Begin
395 Result.Create(parent);
396 Result.SetWindowPos(Left,Bottom,Width,Height);
397 Result.parent := parent;
398End;
399
400
401{
402ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
403º º
404º Speed-Pascal/2 Version 2.0 º
405º º
406º Speed-Pascal Component Classes (SPCC) º
407º º
408º This section: TFileListBox Class Implementation º
409º º
410º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
411º º
412ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
413}
414
415Procedure TFileListBox.SetupComponent;
416Begin
417 Inherited SetupComponent;
418
419 Name := 'FileListBox';
420 Sorted := True;
421 FFileType := [ftNormal];
422 Mask := '';
423 Directory := '';
424End;
425
426
427Procedure TFileListBox.ItemFocus(Index:LongInt);
428Begin
429 Inherited ItemFocus(Index);
430
431 Change;
432End;
433
434
435Procedure TFileListBox.BuildList;
436{$IFDEF OS2}
437Const AttrSet:Array[TFileAttr] Of Word = (faReadOnly,faHidden,faSysFile,0,faDirectory,faArchive,0);
438{$ENDIF}
439{$IFDEF WIN32}
440Const AttrSet:Array[TFileAttr] Of Word = (faReadOnly,faHidden,faSysFile,0,faDirectory,faArchive,faArchive);
441{$ENDIF}
442Var Search:TSearchRec;
443 Status:Integer;
444 Attr:Word;
445 AttrIndex:TFileAttr;
446 S,s1:String;
447Begin
448 If FDirectory=FOldDirectory Then
449 If FMask=FOldMask Then
450 If FFileType=FOldFileType Then exit; //same dir
451 FOldDirectory:=FDirectory;
452 FOldMask:=FMask;
453 FOldFileType:=FFileType;
454
455 BeginUpdate;
456 Clear;
457
458 Attr := 0;
459 For AttrIndex := Low(TFileAttr) To High(TFileAttr) Do
460 Begin
461 If FFileType * [AttrIndex] <> []
462 Then Attr := Attr Or AttrSet[AttrIndex];
463 End;
464
465 S:=fMask;
466 While S<>'' Do
467 Begin
468 If Pos(';',S)<>0 Then
469 Begin
470 s1:=S;
471 Delete(s1,1,Pos(';',S));
472 SetLength(S,Pos(';',S)-1);
473 End
474 Else s1:='';
475
476 Status := FindFirst(FDirectory + '\' + S, Attr,Search);
477 While Status = 0 Do
478 Begin
479 If Search.Attr And faDirectory = faDirectory Then
480 Begin
481 Items.Add('['+ Search.Name +']');
482 End
483 Else Items.Add(Search.Name);
484 Status := FindNext(Search);
485 End;
486 S:=s1;
487 End;
488
489 EndUpdate;
490End;
491
492
493Function TFileListBox.GetDrive:Char;
494Begin
495 Result := FDirectory[1];
496End;
497
498
499Procedure TFileListBox.SetDrive(NewDrive:Char);
500Var NewDir:String;
501Begin
502 If UpCase(NewDrive) <> UpCase(Drive) Then
503 Begin
504 {Change To Current Directory At NewDrive}
505 {$I-}
506 GetDir(Ord(UpCase(NewDrive))-Ord('A')+1, NewDir);
507 {$I+}
508 If IOResult = 0 Then SetDirectory(NewDir);
509 End;
510End;
511
512Procedure TFileListBox.SetDirectory(NewDir:String);
513Var s:String;
514Begin
515 If NewDir = '' Then
516 Begin
517 {$I-}
518 GetDir(0,NewDir);
519 {$I+}
520 End;
521
522 If Pos(':',NewDir)<>2 Then
523 Begin
524 {$I-}
525 GetDir(Ord(UpCase(Drive))-Ord('A')+1,s);
526 {$I+}
527 If (s[length(s)])='\' Then dec(s[0]);
528 If not (NewDir[1] In ['/','\']) Then s:=s+'\';
529 NewDir:=s+NewDir;
530 End;
531
532 If NewDir[Length(NewDir)] = '\' Then SetLength(NewDir,Length(NewDir)-1);
533 If FDirectory=NewDir Then exit;
534 FDirectory := NewDir;
535
536 If Handle<>0 Then BuildList;
537 Change;
538
539 If FDirList <> Nil Then
540 Begin
541 If uppercase(FDirList.Directory) <> uppercase(Directory)
542 Then FDirList.Directory := Directory;
543 End;
544End;
545
546
547Procedure TFileListBox.SetFileName(NewFile:String);
548Var Dir,Name,Ext:String;
549Begin
550 If GetFileName <> NewFile Then
551 Begin
552 FSplit(NewFile,Dir,Name,Ext);
553 If Dir='' Then
554 Begin
555 ItemIndex := Items.IndexOf(NewFile);
556 Change;
557 End
558 Else
559 Begin
560 SetDirectory(Dir);
561 SetFileName(Name+Ext);
562 End;
563 End;
564End;
565
566
567Function TFileListBox.GetFileName:String;
568Var idx:LongInt;
569 s:String;
570Begin
571 idx := ItemIndex;
572 If (idx < 0) Or (idx >= Items.Count) Then Result := ''
573 Else Result := Items[idx];
574 s:=Directory;
575 If s[Length(s)] In ['\','/'] Then dec(s[0]);
576 If s<>'' Then If Result<>'' Then Result:=s+'\'+Result;
577End;
578
579
580Procedure TFileListBox.SetMask(NewMask:String);
581Begin
582 If NewMask <> '' Then
583 Begin
584 If FMask=NewMask Then exit;
585 FMask := NewMask
586 End
587 Else
588 Begin
589 If FMask='*.*' Then exit;
590 FMask := '*.*';
591 End;
592
593 If Handle<>0 Then BuildList;
594 Change;
595End;
596
597
598Procedure TFileListBox.SetFileEdit(NewEdit:TEdit);
599Begin
600 FFileEdit := NewEdit;
601 If FFileEdit <> Nil Then
602 Begin
603 FFileEdit.FreeNotification(Self);
604 If FileName <> '' Then FFileEdit.Caption := FileName
605 Else FFileEdit.Caption := Mask;
606 End;
607End;
608
609
610Procedure TFileListBox.Notification(AComponent:TComponent;Operation:TOperation);
611Begin
612 Inherited Notification(AComponent,Operation);
613
614 If Operation = opRemove Then
615 If AComponent = FFileEdit Then FFileEdit := Nil;
616End;
617
618
619Procedure TFileListBox.SetFileType(Attr:TFileType);
620Begin
621 If FFileType <> Attr Then
622 Begin
623 FFileType := Attr;
624 If Handle<>0 Then BuildList;
625 Change;
626 End;
627End;
628
629
630Procedure TFileListBox.Change;
631Begin
632 If FFileEdit <> Nil Then
633 Begin
634 If FileName <> '' Then FFileEdit.Caption := FileName
635 Else FFileEdit.Caption := Mask;
636
637 FFileEdit.SelectAll;
638 End;
639
640 If FOnChange <> Nil Then FOnChange(Self);
641End;
642
643
644Function TFileListBox.WriteSCUResource(Stream:TResourceStream):Boolean;
645Begin
646 {don't Write contents To SCU}
647 Result := TControl.WriteSCUResource(Stream);
648End;
649
650Procedure TFileListBox.SetupShow;
651Begin
652 Inherited SetupShow;
653
654 BuildList;
655End;
656
657{
658ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
659º º
660º Speed-Pascal/2 Version 2.0 º
661º º
662º Speed-Pascal Component Classes (SPCC) º
663º º
664º This section: TDirectoryListBox Class Implementation º
665º º
666º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
667º º
668ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
669}
670
671
672Procedure TDirectoryListBox.SetupComponent;
673Begin
674 Inherited SetupComponent;
675
676 Name := 'DirectoryListBox';
677 sorted := True;
678 Directory := '';
679 Style:=lbOwnerDrawFixed;
680End;
681
682Procedure TDirectoryListBox.MeasureItem(Index:LongInt;Var Width,Height:LongInt);
683Begin
684 Inherited MeasureItem(Index,Width,Height);
685 If Height<15 Then Height:=15;
686End;
687
688Procedure TDirectoryListBox.DrawItem(Index:LongInt;rec:TRect;State:TOwnerDrawState);
689Var X,Y,Y1,CX,CY,cx1,cy1:LongInt;
690 S,Dir,Dir1:String;
691 t:LongInt;
692Begin
693 If State * [odSelected] <> [] Then
694 Begin
695 Canvas.Pen.color := clHighlightText;
696 Canvas.Brush.color := clHighlight;
697 End
698 Else
699 Begin
700 Canvas.Pen.color := PenColor;
701 Canvas.Brush.color := color;
702 End;
703 Canvas.FillRect(rec,Canvas.Brush.color);
704
705 X := rec.Left + 1;
706 Y := rec.Bottom + 1;
707 CX := rec.Right - X;
708 CY := rec.Top - Y;
709
710 S := Items.Strings[Index];
711
712 For t:=1 To Length(S) Do
713 If S[t] In ['\','/'] Then inc(X,2);
714
715 If Index>0 Then inc(X,2);
716 Y1:=Y+((CY-13) Div 2);
717 If Y1 < rec.Bottom+1 Then Y1 := rec.Bottom+1;
718 inc(Y1);
719 Dir:=Directory;
720 UpcaseStr(Dir);
721 Dir1:=S;
722 UpcaseStr(Dir1);
723 If ((Index=0)Or(Pos(Dir1,Dir)<>0)) Then DrawOpenFolder(X,Y1)
724 Else DrawClosedFolder(X,Y1);
725 inc(X,20);
726
727 t:=Pos('\',S);
728 If t=0 Then t:=Pos('/',S);
729 If Index>0 Then While t<>0 Do
730 Begin
731 Delete(S,1,t);
732 t:=Pos('\',S);
733 If t=0 Then t:=Pos('/',S);
734 End;
735
736 Canvas.GetTextExtent(S,cx1,cy1);
737 Y := Y + ((CY - cy1) Div 2);
738 If Y < rec.Bottom Then Y := rec.Bottom;
739 Canvas.Brush.Mode := bmTransparent;
740 Canvas.TextOut(X,Y,S);
741 Canvas.Brush.Mode := bmOpaque;
742End;
743
744Procedure TDirectoryListBox.DrawOpenFolder(X,Y:LongInt);
745Var SaveBrushColor,SavePenColor:TColor;
746Begin
747 SaveBrushColor:=Canvas.Brush.Color;
748 SavePenColor:=Canvas.Pen.Color;
749
750 Canvas.Brush.Style:=bsDiagCross;
751 Canvas.Brush.Color:=clYellow;
752 Canvas.Pen.Color:=clWhite;
753 Canvas.Polygon([Point(X+3,Y),Point(X+16,Y),Point(X+16,Y+10),
754 Point(X+15,Y+10),Point(X+14,Y+12),Point(X+10,Y+12),
755 Point(X+9,Y+10),Point(X+3,Y+10),Point(X+3,Y+8),
756 Point(X,Y+8)]);
757
758
759 Canvas.PenPos:=Point(X+3,Y);
760 Canvas.Pen.Color:=clBlack;
761 Canvas.LineTo(X+16,Y);
762 Canvas.LineTo(X+16,Y+10);
763 Canvas.LineTo(X+15,Y+10);
764 Canvas.LineTo(X+14,Y+12);
765 Canvas.LineTo(X+10,Y+12);
766 Canvas.LineTo(X+9,Y+10);
767 Canvas.LineTo(X+3,Y+10);
768 Canvas.LineTo(X+3,Y+8);
769
770 Canvas.PenPos:=Point(X+16,Y);
771 Canvas.LineTo(X+13,Y+8);
772 Canvas.LineTo(X,Y+8);
773 Canvas.LineTo(X+3,Y);
774
775 Canvas.Brush.Style:=bsSolid;
776 Canvas.Brush.Color:=SaveBrushColor;
777 Canvas.Pen.Color:=SavePenColor;
778End;
779
780Procedure TDirectoryListBox.DrawClosedFolder(X,Y:LongInt);
781Var SaveBrushColor,SavePenColor:TColor;
782Begin
783 SaveBrushColor:=Canvas.Brush.Color;
784 SavePenColor:=Canvas.Pen.Color;
785
786 Canvas.Brush.Style:=bsDiagCross;
787 Canvas.Brush.Color:=clYellow;
788 Canvas.Pen.Color:=clWhite;
789 Canvas.Polygon([Point(X+3,Y),Point(X+16,Y),Point(X+16,Y+10),
790 Point(X+15,Y+10),Point(X+14,Y+12),Point(X+10,Y+12),
791 Point(X+9,Y+10),Point(X+3,Y+10)]);
792
793 Canvas.PenPos:=Point(X+3,Y);
794 Canvas.Pen.Color:=clBlack;
795 Canvas.LineTo(X+16,Y);
796 Canvas.LineTo(X+16,Y+10);
797 Canvas.LineTo(X+15,Y+10);
798 Canvas.LineTo(X+14,Y+12);
799 Canvas.LineTo(X+10,Y+12);
800 Canvas.LineTo(X+9,Y+10);
801 Canvas.LineTo(X+3,Y+10);
802 Canvas.LineTo(X+3,Y);
803
804 Canvas.Brush.Style:=bsSolid;
805 Canvas.Brush.Color:=SaveBrushColor;
806 Canvas.Pen.Color:=SavePenColor;
807End;
808
809Procedure TDirectoryListBox.ItemSelect(Index:LongInt);
810Var S,S1:String;
811 t:LongInt;
812Begin
813 If (Index < 0) Or (Index > Items.Count-1) Then Exit;
814
815 S := Items.Strings[Index];
816 Directory:=S;
817
818 Inherited ItemSelect(Index);
819
820 UpcaseStr(S);
821 For t:=0 To Items.Count-1 Do
822 Begin
823 S1:=Items[t];
824 UpcaseStr(S1);
825 If S=S1 Then
826 Begin
827 ItemIndex:=t;
828 exit;
829 End;
830 End;
831End;
832
833Procedure TDirectoryListBox.BuildList;
834Var S,S1:String;
835 Search:TSearchRec;
836 Status:Integer;
837 b:Byte;
838 t:LongInt;
839 Dir:String;
840Begin
841 If FDirectory=FOldDirectory Then exit; //same dir
842 FOldDirectory:=FDirectory;
843
844 BeginUpdate;
845 Clear;
846
847 //Add Drive
848 Items.Clear;
849 Items.Add(Drive+':\');
850
851 //Add all subdirs
852 S:=Directory;
853 S[3]:=#1; //replace \
854 b:=Pos('\',S);
855 If b=0 Then b:=Pos('/',S);
856 While b<>0 Do
857 Begin
858 S1:=Copy(s,1,b-1);
859 S[b]:=#1; //replace \
860
861 For t:=1 To Length(S1) Do If S1[t]=#1 Then S1[t]:='\'; //replace #
862 Items.Add(S1);
863
864 b:=Pos('\',S);
865 If b=0 Then b:=Pos('/',S);
866 End;
867 For t:=1 To Length(S) Do If S[t]=#1 Then S[t]:='\'; //replace #
868 If length(S)>3 Then Items.Add(S);
869
870 Dir:=Directory;
871 If Dir[Length(Dir)] In ['\','/'] Then Dec(Dir[0]);
872 Status := FindFirst(Dir+'\*.*',faDirectory,Search);
873 While Status = 0 Do
874 Begin
875 S := Search.Name;
876 If Search.Attr And faDirectory = faDirectory Then
877 Begin
878 {avoid .. In Mainpath}
879 If S <> '.' Then
880 If S <> '..' Then Items.Add(Dir+'\'+S);
881 End;
882 Status := FindNext(Search);
883 End;
884
885 EndUpdate;
886End;
887
888
889Procedure TDirectoryListBox.SetDirectory(NewDir:String);
890Var s:String;
891Begin
892 If NewDir = '' Then
893 Begin
894 {$I-}
895 GetDir(0,NewDir);
896 {$I+}
897 End;
898
899 If Pos(':',NewDir)<>2 Then
900 Begin
901 {$I-}
902 GetDir(Ord(UpCase(Drive))-Ord('A')+1,s);
903 {$I+}
904 If (s[length(s)])='\' Then dec(s[0]);
905 If not (NewDir[1] In ['/','\']) Then s:=s+'\';
906 NewDir:=s+NewDir;
907 End;
908
909 If NewDir[Length(NewDir)] In ['\','/'] Then
910 If Length(NewDir)>3 Then dec(NewDir[0]);
911 If FDirectory=NewDir Then exit;
912 FDirectory := NewDir;
913
914 If Handle<>0 Then BuildList;
915 Change;
916
917 If FDriveCombo <> Nil Then
918 Begin
919 If UpCase(FDriveCombo.Drive) <> UpCase(Drive)
920 Then FDriveCombo.Drive := Drive;
921 End;
922End;
923
924
925Procedure TDirectoryListBox.SetDrive(NewDrive:Char);
926Var NewDir:String;
927Begin
928 If UpCase(NewDrive) <> UpCase(Drive) Then
929 Begin
930 {Change To Current Directory At NewDrive}
931 {$I-}
932 GetDir(Ord(UpCase(NewDrive))-Ord('A')+1, NewDir);
933 {$I+}
934 If IOResult = 0 Then SetDirectory(NewDir);
935 End;
936End;
937
938
939Function TDirectoryListBox.GetDrive:Char;
940Begin
941 Result := FDirectory[1];
942End;
943
944
945Procedure TDirectoryListBox.SetDirLabel(ALabel:TLabel);
946Begin
947 FDirLabel := ALabel;
948 If FDirLabel <> Nil Then
949 Begin
950 FDirLabel.FreeNotification(Self);
951 FDirLabel.Caption := FDirectory;
952 End;
953End;
954
955
956Procedure TDirectoryListBox.SetFileListBox(AFileList:TFileListBox);
957Begin
958 If FFileList <> Nil Then FFileList.FDirList := Nil;
959 FFileList := AFileList;
960 If FFileList <> Nil Then
961 Begin
962 FFileList.FDirList := Self;
963 FFileList.FreeNotification(Self);
964 End;
965End;
966
967
968Procedure TDirectoryListBox.Notification(AComponent:TComponent;Operation:TOperation);
969Begin
970 Inherited Notification(AComponent,Operation);
971
972 If Operation = opRemove Then
973 Begin
974 If AComponent = FFileList Then FFileList := Nil;
975 If AComponent = FDirLabel Then FDirLabel := Nil;
976 End;
977End;
978
979
980Procedure TDirectoryListBox.Change;
981Begin
982 If FDirLabel <> Nil Then FDirLabel.Caption := FDirectory;
983 If FFileList <> Nil Then FFileList.Directory := FDirectory;
984
985 If FOnChange <> Nil Then FOnChange(Self);
986End;
987
988
989Function TDirectoryListBox.WriteSCUResource(Stream:TResourceStream):Boolean;
990Begin
991 {don't Write contents To SCU}
992 Result := TControl.WriteSCUResource(Stream);
993End;
994
995Procedure TDirectoryListBox.SetupShow;
996Begin
997 Inherited SetupShow;
998
999 BuildList;
1000End;
1001
1002{
1003ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1004º º
1005º Speed-Pascal/2 Version 2.0 º
1006º º
1007º Speed-Pascal Component Classes (SPCC) º
1008º º
1009º This section: TDriveComboBox Class Implementation º
1010º º
1011º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1012º º
1013ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1014}
1015
1016
1017Procedure TDriveComboBox.SetupComponent;
1018Var DriveMap:LongWord;
1019 SDrive:Byte;
1020 actdir:String;
1021 {$IFDEF OS2}
1022 ActualDrive:LongWord;
1023 {$ENDIF}
1024Begin
1025 Inherited SetupComponent;
1026
1027 Name := 'DriveComboBox';
1028 Style := csDropDownList;
1029 sorted := False;
1030
1031 {Fill Drive Combo}
1032 {$IFDEF OS2}
1033 DosQueryCurrentDisk(ActualDrive,DriveMap);
1034 {$ENDIF}
1035 {$IFDEF Win95}
1036 DriveMap := GetLogicalDrives;
1037 {$ENDIF}
1038 For SDrive := 0 To 25 Do
1039 Begin
1040 If DriveMap And (1 Shl SDrive) <> 0 Then
1041 Begin
1042 actdir := Chr(SDrive + 65) + ':';
1043 Items.Add(actdir);
1044 End;
1045 End;
1046
1047 {$I-}
1048 GetDir(0,actdir);
1049 {$I+}
1050 Drive := actdir[1];
1051End;
1052
1053
1054Procedure TDriveComboBox.ItemSelect(Index:LongInt);
1055Var S:String;
1056Begin
1057 Inherited ItemSelect(Index);
1058
1059 S := Text;
1060 If S <> '' Then Drive := S[1];
1061End;
1062
1063
1064Procedure TDriveComboBox.Change;
1065Begin
1066 If FDirList <> Nil Then FDirList.Drive := FDrive;
1067
1068 If FOnChange <> Nil Then FOnChange(Self);
1069End;
1070
1071
1072Procedure TDriveComboBox.SetDrive(NewDrive:Char);
1073Var S:String;
1074 T:LongInt;
1075 C:cstring;
1076 cc:^cstring;
1077 {$IFDEF Win95}
1078 sernum,complen,Flags:LongWord;
1079 FileSystem,volname:cstring;
1080 {$ENDIF}
1081Label L;
1082Begin
1083 NewDrive := UpCase(NewDrive);
1084 If UpCase(FDrive) = NewDrive Then Exit;
1085
1086 S := Text;
1087 If NewDrive <> S[1] Then
1088 Begin
1089 For T := 0 To Items.Count-1 Do
1090 Begin
1091 S := Items.Strings[T];
1092 If UpCase(S[1]) = NewDrive Then
1093 Begin
1094 Text := S;
1095 Goto L;
1096 End;
1097 End;
1098 {Not found In List}
1099 NewDrive := FDrive; {Use Current Drive}
1100 End;
1101L:
1102 FDrive := NewDrive;
1103 If Pos('[',S) = 0 Then
1104 Begin
1105 {determine volume id's}
1106 T := Items.IndexOf(S);
1107 If T <> -1 Then
1108 Begin
1109 FillChar(C,255,0);
1110 {$IFDEF OS2}
1111 DosErrorAPI(FERR_DISABLEHARDERR); {no effect}
1112 DosQueryFSInfo(Ord(S[1])-64,FSIL_VOLSER,C,255);
1113 DosErrorAPI(FERR_ENABLEHARDERR);
1114 cc := @C[5];
1115 If cc^ <> '' Then S := S +' ['+ cc^ +']';
1116 {$ENDIF}
1117 {$IFDEF Win95}
1118 C := S[1] + ':\';
1119 volname := '';
1120 GetVolumeInformation(C,volname,255,sernum,complen,Flags,
1121 FileSystem,255);
1122 If volname <> '' Then S := S + ' ['+ volname +']';
1123 {$ENDIF}
1124 Text := S;
1125 Items[T] := S;
1126 End;
1127 End;
1128
1129 Change;
1130End;
1131
1132
1133Procedure TDriveComboBox.SetDirListBox(ADirList:TDirectoryListBox);
1134Begin
1135 If FDirList <> Nil Then FDirList.FDriveCombo := Nil;
1136 FDirList := ADirList;
1137 If FDirList <> Nil Then
1138 Begin
1139 FDirList.FDriveCombo := Self;
1140 FDirList.FreeNotification(Self);
1141 End;
1142End;
1143
1144
1145Procedure TDriveComboBox.Notification(AComponent:TComponent;Operation:TOperation);
1146Begin
1147 Inherited Notification(AComponent,Operation);
1148
1149 If Operation = opRemove Then
1150 If AComponent = FDirList Then FDirList := Nil;
1151End;
1152
1153
1154Function TDriveComboBox.WriteSCUResource(Stream:TResourceStream):Boolean;
1155Begin
1156 {don't Write contents To SCU}
1157 Result := TControl.WriteSCUResource(Stream);
1158End;
1159
1160
1161{
1162ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1163º º
1164º Speed-Pascal/2 Version 2.0 º
1165º º
1166º Speed-Pascal Component Classes (SPCC) º
1167º º
1168º This section: TDriveComboBox Class Implementation º
1169º º
1170º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1171º º
1172ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1173}
1174
1175Procedure TFilterComboBox.SetupComponent;
1176Begin
1177 Inherited SetupComponent;
1178
1179 Name := 'FilterComboBox';
1180 Style := csDropDownList;
1181 sorted := False;
1182
1183 FFilter := LoadNLSStr(SAllFiles)+' (*.*)|*.*';
1184 FMaskList.Create;
1185End;
1186
1187
1188Procedure TFilterComboBox.SetupShow;
1189Begin
1190 Inherited SetupShow;
1191
1192 BuildList;
1193End;
1194
1195
1196Destructor TFilterComboBox.Destroy;
1197Begin
1198 FMaskList.Destroy;
1199 FMaskList := Nil;
1200
1201 Inherited Destroy;
1202End;
1203
1204
1205Procedure TFilterComboBox.ItemSelect(Index:LongInt);
1206Begin
1207 Inherited ItemSelect(Index);
1208
1209 Text := Items[Index];
1210 Change;
1211End;
1212
1213
1214Procedure TFilterComboBox.Change;
1215Begin
1216 If FFileList <> Nil Then FFileList.Mask := Mask;
1217
1218 If FOnChange <> Nil Then FOnChange(Self);
1219End;
1220
1221
1222Procedure TFilterComboBox.BuildList;
1223Var AMask,AFilter:String;
1224 S:String;
1225 P:Integer;
1226Begin
1227 BeginUpdate;
1228 Clear;
1229 FMaskList.Clear;
1230
1231 S := FFilter;
1232 P := Pos('|',S);
1233 While P > 0 Do
1234 Begin
1235 AFilter := Copy(S,1,P-1);
1236 Delete(S,1,P);
1237 P := Pos('|',S);
1238 If P > 0 Then
1239 Begin
1240 AMask := Copy(S,1,P-1);
1241 Delete(S,1,P);
1242 End
1243 Else
1244 Begin
1245 AMask := S;
1246 S := '';
1247 End;
1248 Items.Add(AFilter);
1249 FMaskList.Add(AMask);
1250 P := Pos('|',S);
1251 End;
1252 EndUpdate;
1253 ItemIndex := 0;
1254End;
1255
1256
1257Procedure TFilterComboBox.SetFilter(NewFilter:String);
1258Begin
1259 If FFilter <> NewFilter Then
1260 Begin
1261 FFilter := NewFilter;
1262 BuildList;
1263 Change;
1264 End;
1265End;
1266
1267
1268Procedure TFilterComboBox.SetFileListBox(AFileList:TFileListBox);
1269Begin
1270 If FFileList <> Nil Then FFileList.FFilterCombo := Nil;
1271 FFileList := AFileList;
1272 If FFileList <> Nil Then
1273 Begin
1274 FFileList.FFilterCombo := Self;
1275 FFileList.FreeNotification(Self);
1276 End;
1277End;
1278
1279
1280Procedure TFilterComboBox.Notification(AComponent:TComponent;Operation:TOperation);
1281Begin
1282 Inherited Notification(AComponent,Operation);
1283
1284 If Operation = opRemove Then
1285 If AComponent = FFileList Then FFileList := Nil;
1286End;
1287
1288
1289Function TFilterComboBox.GetMask:String;
1290Var idx:LongInt;
1291Begin
1292 idx := ItemIndex;
1293 If (idx < 0) Or (idx >= FMaskList.Count) Then Result := '*.*'
1294 Else Result := FMaskList[idx];
1295End;
1296
1297
1298Function TFilterComboBox.WriteSCUResource(Stream:TResourceStream):Boolean;
1299Begin
1300 {don't Write contents To SCU}
1301 Result := TControl.WriteSCUResource(Stream);
1302End;
1303
1304
1305Begin
1306End.
Note: See TracBrowser for help on using the repository browser.