source: trunk/Components/CustomFileControls.pas@ 213

Last change on this file since 213 was 213, checked in by RBRi, 18 years ago

use FileConstants
  • Property svn:eol-style set to native
File size: 39.4 KB
RevLine 
[15]1Unit CustomFileControls;
2
3// 26/9/0
4// Fixed filter combo box for when filter is invalid and results in
5// no list entries: crashes because it tries to set item index to 0.
6Interface
7
8Uses
[188]9 Dos,
10 SysUtils,
11 Classes,
12 Forms,
13 StdCtrls,
14 CustomListBox,
15 Graphics;
[15]16
17
18Type
19 TCustomDirectoryListBox=Class;
20 TCustomDriveComboBox=Class;
21 TCustomFilterComboBox=Class;
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 TCustomFilelistBox=Class(TCustomListBox)
29 Private
30 FMask: String;
31 FExcludeMask: string;
32 FOldMask: String;
33 FDirectory: String;
34 FOldDirectory: String;
35 FFileType: TFileType;
36 FOldFileType: TFileType;
37 FFileEdit: TEdit;
38 FFilterCombo: TCustomFilterComboBox;
39 FOnChange: TNotifyEvent;
40 FDirList: TCustomDirectoryListBox;
41 Function GetDrive:Char;
42 Procedure SetDrive(NewDrive:Char);
43 Procedure SetDirectory(NewDir:String);
44 Procedure SetFileName(NewFile:String);
45 Function GetFileName:String;
46 Procedure SetMask(NewMask:String);
47 Procedure SetExcludeMask(NewMask:String);
48 Procedure SetFileType(Attr:TFileType);
49 Procedure SetFileEdit(NewEdit:TEdit);
50 Procedure BuildList;
51 Protected
52 Procedure SetupComponent;Override;
53 Procedure Notification(AComponent:TComponent;Operation:TOperation);Override;
54 Procedure ItemFocus(Index:LongInt);Override;
55 Procedure Change;Virtual;
56 Property Duplicates;
57 Property Sorted;
58 Procedure SetupShow;Override;
59 Public
60 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
61 Property FileName:String Read GetFileName Write SetFileName;
62 Property Directory:String Read FDirectory Write SetDirectory;
63 Property Drive:Char Read GetDrive Write SetDrive;
64 Procedure Reload;
65 Published
66 Property FileEdit:TEdit Read FFileEdit Write SetFileEdit;
67 Property FileType:TFileType Read FFileType Write SetFileType;
68 Property Mask:String Read fMask Write SetMask;
69 Property ExcludeMask:String Read fExcludeMask Write SetExcludeMask;
70 Property OnChange:TNotifyEvent Read FOnChange Write FOnChange;
71 End;
72
73 TCustomDirectoryListBox=Class(TListBox)
74 Private
75 FPictureOpen: TBitmap;
76 FPictureClosed: TBitmap;
77 FPictureOpenMask: TBitmap;
78 FPictureClosedMask: TBitmap;
79 FDirectory: String;
80 FDirLabel: TLabel;
81 FFileList: TCustomFileListBox;
82 FOnChange: TNotifyEvent;
83 FDriveCombo: TCustomDriveComboBox;
84 Procedure SetDirectory(NewDir:String);
85 Function GetDrive:Char;
86 Procedure SetDrive(NewDrive:Char);
87 Procedure SetDirLabel(ALabel:TLabel);
88 Procedure SetFilelistBox(AFileList:TCustomFileListBox);
89 Procedure BuildList;
90 Protected
91 Procedure SetupComponent;Override;
92 Procedure Notification(AComponent:TComponent;Operation:TOperation);Override;
93 Procedure ItemSelect(Index:LongInt);Override;
94 Procedure Change;Virtual;
95 Procedure DrawOpenFolder( Var X: longint; Y: LongInt );
96 Procedure DrawClosedFolder( Var X: longint; Y: LongInt );
97 Procedure MeasureItem(Index:LongInt;Var Width,Height:LongInt);Override;
98 Procedure DrawItem( Index: LongInt;
99 rec: TRect;
100 State: TOwnerDrawState );Override;
101 Procedure SetupShow;Override;
102
103 Procedure SetPictureOpen(NewBitmap:TBitmap);
104 Procedure SetPictureClosed(NewBitmap:TBitmap);
105
106 Property Duplicates;
107 Property ExtendedSelect;
108 Property MultiSelect;
109 Property Sorted;
110 Property Style;
111 Property OnDrawItem;
112 Property OnMeasureItem;
113 Property Items;
114
115 Public
116 Destructor Destroy; Override;
117 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
118 Property Directory:String Read FDirectory Write SetDirectory;
119 Property Drive:Char Read GetDrive Write SetDrive;
120 Property XAlign;
121 Property XStretch;
122 Property YAlign;
123 Property YStretch;
124 Published
125 Property Align;
126 Property Color;
127 Property PenColor;
128 Property DirLabel:TLabel Read FDirLabel Write SetDirLabel;
129 Property DragCursor;
130 Property DragMode;
131 Property Enabled;
132 Property FileList:TCustomFileListBox Read FFileList Write SetFilelistBox;
133 Property Font;
134 Property HorzScroll;
135 Property IntegralHeight;
136 Property ItemHeight;
137 Property ParentColor;
138 Property ParentPenColor;
139 Property ParentFont;
140 Property ParentShowHint;
141 Property ShowDragRects;
142 Property ShowHint;
143 Property TabOrder;
144 Property TabStop;
145 Property Visible;
146 Property ZOrder;
147
148 Property PictureClosed:TBitmap Read FPictureClosed Write SetPictureClosed;
149 Property PictureOpen:TBitmap Read FPictureOpen Write SetPictureOpen;
150
151 Property OnCanDrag;
152 Property OnChange:TNotifyEvent Read FOnChange Write FOnChange;
153 Property OnDragDrop;
154 Property OnDragOver;
155 Property OnEndDrag;
156 Property OnEnter;
157 Property OnExit;
158 Property OnFontChange;
159 Property OnKeyPress;
160 Property OnMouseClick;
161 Property OnMouseDblClick;
162 Property OnMouseDown;
163 Property OnMouseMove;
164 Property OnMouseUp;
165 Property OnScan;
166 Property OnSetupShow;
167 Property OnStartDrag;
168 End;
169
170 {$HINTS OFF}
171 TCustomDriveComboBox=Class(TComboBox)
172 Private
173 FDirList:TCustomDirectoryListBox;
174 FOnChange:TNotifyEvent;
175 FLastIndex:longint;
176 Function GetDrive:Char;
177 Procedure SetDrive(NewDrive:Char);
178 Procedure SetDirListBox(ADirList:TCustomDirectoryListBox);
179 Protected
180 Procedure SetupComponent;Override;
181 Procedure Notification(AComponent:TComponent;Operation:TOperation);Override;
182 Procedure ItemSelect(Index:LongInt);Override;
183 Procedure Change;Virtual;
184 Property Duplicates;
185 Property MaxLength;
186 Property SelLength;
187 Property SelStart;
188 Property SelText;
189 Property Sorted;
190 Property Style;
191 Property TextExtension;
192 Procedure DrawItem( Canvas: TCanvas;
193 S: string;
194 Data: TObject;
195 rec: TRect;
196 State: TOwnerDrawState );
197 Public
198 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
199 Property Drive:Char Read GetDrive Write SetDrive;
200 Property Items;
201 Property Text;
202 Property XAlign;
203 Property XStretch;
204 Property YAlign;
205 Property YStretch;
206 Published
207 Property Align;
208 Property Color;
209 Property PenColor;
210 Property DirList:TCustomDirectoryListBox Read FDirList Write SetDirListBox;
211 Property DragCursor;
212 Property DragMode;
213 Property DropDownCount;
214 Property Enabled;
215 Property Font;
216 Property ParentColor;
217 Property ParentPenColor;
218 Property ParentFont;
219 Property ParentShowHint;
220 Property ShowHint;
221 Property TabOrder;
222 Property TabStop;
223 Property Visible;
224 Property ZOrder;
225
226 Property OnCanDrag;
227 Property OnChange:TNotifyEvent Read FOnChange Write FOnChange;
228 Property OnDragDrop;
229 Property OnDragOver;
230 Property OnDropDown;
231 Property OnEndDrag;
232 Property OnEnter;
233 Property OnExit;
234 Property OnFontChange;
235 Property OnKeyPress;
236 Property OnMouseClick;
237 Property OnMouseDblClick;
238 Property OnMouseDown;
239 Property OnMouseMove;
240 Property OnMouseUp;
241 Property OnScan;
242 Property OnSetupShow;
243 Property OnStartDrag;
244 End;
245 {$HINTS ON}
246
247
248 {$HINTS OFF}
249 TCustomFilterComboBox=Class(TComboBox)
250 Private
251 FFilter:String;
252 FFileList:TCustomFilelistBox;
253 FMaskList:TStringList;
254 FOnChange:TNotifyEvent;
255 Procedure SetFilter(NewFilter:String);
256 Procedure SetFilelistBox(AFileList:TCustomFilelistBox);
257 Function GetMask:String;
258 Procedure BuildList;
259 Protected
260 Procedure SetupComponent;Override;
261 Procedure Notification(AComponent:TComponent;Operation:TOperation);Override;
262 Procedure SetupShow;Override;
263 Procedure ItemSelect(Index:LongInt);Override;
264 Procedure Change;Virtual;
265 Property Duplicates;
266 Property MaxLength;
267 Property SelLength;
268 Property SelStart;
269 Property SelText;
270 Property Sorted;
271 Property Style;
272 Property TextExtension;
273 Public
274 Destructor Destroy;Override;
275 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
276 Property Mask:String Read GetMask;
277 Property Items;
278 Property Text;
279 Property XAlign;
280 Property XStretch;
281 Property YAlign;
282 Property YStretch;
283 Published
284 Property Align;
285 Property Color;
286 Property PenColor;
287 Property DragCursor;
288 Property DragMode;
289 Property DropDownCount;
290 Property Enabled;
291 Property FileList:TCustomFilelistBox Read FFileList Write SetFilelistBox;
292 Property Filter:String Read FFilter Write SetFilter;
293 Property Font;
294 Property ParentColor;
295 Property ParentPenColor;
296 Property ParentFont;
297 Property ParentShowHint;
298 Property ShowHint;
299 Property TabOrder;
300 Property TabStop;
301 Property Visible;
302 Property ZOrder;
303
304 Property OnCanDrag;
305 Property OnChange:TNotifyEvent Read FOnChange Write FOnChange;
306 Property OnDragDrop;
307 Property OnDragOver;
308 Property OnDropDown;
309 Property OnEndDrag;
310 Property OnEnter;
311 Property OnExit;
312 Property OnFontChange;
313 Property OnKeyPress;
314 Property OnMouseClick;
315 Property OnMouseDblClick;
316 Property OnMouseDown;
317 Property OnMouseMove;
318 Property OnMouseUp;
319 Property OnScan;
320 Property OnSetupShow;
321 Property OnStartDrag;
322 End;
323 {$HINTS ON}
324
325
326
327Function InsertCustomFilelistBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TCustomFilelistBox;
328Function InsertCustomDirectoryListBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TCustomDirectoryListBox;
329Function InsertCustomDriveComboBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TCustomDriveComboBox;
330Function InsertFilterComboBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TCustomFilterComboBox;
331
332Exports
333 TCustomFileListBox, 'User', 'CustomFileListBox.bmp',
334 TCustomDirectoryListBox, 'User', 'CustomDirectoryListBox.bmp';
335
336Exports
337 TCustomDriveComboBox, 'User', 'CustomDriveComboBox.bmp';
338
339Exports
340 TCustomFilterComboBox, 'User', 'CustomFilterComboBox.bmp';
341
342Implementation
343
344Uses
[188]345 BseDos,
346 OS2Def,
347 BseDev,
348 BseErr,
[15]349
350 Dialogs,
[188]351 FileUtilsUnit,
352 ACLUtility,
[213]353 BitmapUtility,
354 StringUtilsUnit;
[15]355
356var
357 DriveTypeBitmaps: array[ Low( TDriveType ).. High( TDriveType ) ] of TBitmap;
358 DriveTypeBitmapMasks: array[ Low( TDriveType ).. High( TDriveType ) ] of TBitmap;
359
360const
361 DriveTypeBitmapNames: array[ Low( TDriveType ).. High( TDriveType ) ] of string =
362 (
363 '',
364 'FloppyDrive',
365 'HardDrive',
366 'CDDrive',
367 'NetworkDrive',
368 'RemovableDrive'
369 );
370
371{$R FileImages}
372
373Function InsertCustomFilelistBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TCustomFilelistBox;
374Begin
375 Result.Create(parent);
376 Result.SetWindowPos(Left,Bottom,Width,Height);
377 Result.parent := parent;
378End;
379
380
381Function InsertCustomDirectoryListBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TCustomDirectoryListBox;
382Begin
383 Result.Create(parent);
384 Result.SetWindowPos(Left,Bottom,Width,Height);
385 Result.parent := parent;
386End;
387
388
389Function InsertCustomDriveComboBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TCustomDriveComboBox;
390Begin
391 Result.Create(parent);
392 Result.SetWindowPos(Left,Bottom,Width,Height);
393 Result.parent := parent;
394End;
395
396
397Function InsertFilterComboBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TCustomFilterComboBox;
398Begin
399 Result.Create(parent);
400 Result.SetWindowPos(Left,Bottom,Width,Height);
401 Result.parent := parent;
402End;
403
404// ---------------------------------------------------------------------
405// TCustomFilelistBox
406// ---------------------------------------------------------------------
407
408Procedure TCustomFilelistBox.SetupComponent;
409Begin
410 Inherited SetupComponent;
411
412 Name := 'FileListBox';
413 Sorted := True;
414 FFileType := [ftNormal];
415 Mask := '';
416 Directory := '';
417 ExcludeMask:='';
418End;
419
420
421Procedure TCustomFilelistBox.ItemFocus(Index:LongInt);
422Begin
423 Inherited ItemFocus(Index);
424
425 Change;
426End;
427
428Procedure TCustomFilelistBox.BuildList;
429{$IFDEF OS2}
430Const AttrSet:Array[TFileAttr] Of Word = (faReadOnly,faHidden,faSysFile,0,faDirectory,faArchive,0);
431{$ENDIF}
432{$IFDEF WIN32}
433Const AttrSet:Array[TFileAttr] Of Word = (faReadOnly,faHidden,faSysFile,0,faDirectory,faArchive,faArchive);
434{$ENDIF}
435Var Search:TSearchRec;
436 Status:Integer;
437 Attr:Word;
438 AttrIndex:TFileAttr;
439 S,s1:String;
440 ExcludeList:TStringList;
441 FindIndex:longint;
442 ThisFilter: string;
443 NextFilter: integer;
444Begin
445 FOldDirectory:=FDirectory;
446 FOldMask:=FMask;
447 FOldFileType:=FFileType;
448
449 BeginUpdate;
450 Clear;
451
452 DosErrorAPI( FERR_DISABLEHARDERR );
453
454 Attr := 0;
455 For AttrIndex := Low(TFileAttr) To High(TFileAttr) Do
456 Begin
457 If FFileType * [AttrIndex] <> []
458 Then Attr := Attr Or AttrSet[AttrIndex];
459 End;
460
461 // First make a list of files to exclude...
462 ExcludeList:= TStringList.Create;
463 ExcludeList.Sorted:= true;
464 S:=fExcludeMask;
465 While S<>'' Do
466 Begin
[213]467 NextFilter:=Pos(PATH_SEPARATOR,S);
[15]468 If NextFilter<>0 Then
469 Begin
470 ThisFilter:=Copy( S, 1, NextFilter-1 );
471 Delete( S, 1, NextFilter );
472 End
473 Else
474 Begin
475 ThisFilter:=S;
476 S:='';
477 End;
478
[213]479 Status := SysUtils.FindFirst(FDirectory + DIRECTORY_SEPARATOR + ThisFilter, Attr,Search);
[15]480 While Status = 0 Do
481 Begin
482 ExcludeList.Add( Search.Name );
483 Status := SysUtils.FindNext(Search);
484 End;
485 SysUtils.FindClose( Search );
486 End;
487
488 // Now search for files to include...
489 S:=fMask;
490 While S<>'' Do
491 Begin
[213]492 If Pos(PATH_SEPARATOR,S)<>0 Then
[15]493 Begin
494 s1:=S;
[213]495 Delete(s1,1,Pos(PATH_SEPARATOR,S));
496 SetLength(S,Pos(PATH_SEPARATOR,S)-1);
[15]497 End
498 Else s1:='';
499
[213]500 Status := SysUtils.FindFirst(FDirectory + DIRECTORY_SEPARATOR + S, Attr,Search);
[15]501 While Status = 0 Do
502 Begin
503 if not ExcludeList.Find( Search.Name,
504 FindIndex ) then
505 begin
506 If Search.Attr And faDirectory = faDirectory Then
507 Begin
508 Items.Add( '['+ Search.Name +']' );
509 End
510 Else
511 Begin
512 Items.Add( Search.Name );
513 End;
514 end;
515 Status := SysUtils.FindNext(Search);
516 End;
517 SysUtils.FindClose( Search );
518 S:=s1;
519 End;
520
521 DosErrorAPI( FERR_ENABLEHARDERR );
522
523 ExcludeList.Destroy;
524 EndUpdate;
525End;
526
527
528Function TCustomFilelistBox.GetDrive:Char;
529Begin
530 Result := FDirectory[1];
531End;
532
533
534Procedure TCustomFilelistBox.SetDrive(NewDrive:Char);
535Var NewDir:String;
536Begin
537 If UpCase(NewDrive) <> UpCase(Drive) Then
538 Begin
539 {Change To Current Directory At NewDrive}
540 {$I-}
541 GetDir(Ord(UpCase(NewDrive))-Ord('A')+1, NewDir);
542 {$I+}
543 If IOResult = 0 Then SetDirectory(NewDir);
544 End;
545End;
546
547Procedure TCustomFilelistBox.SetDirectory(NewDir:String);
548Var s:String;
549Begin
550 If NewDir = '' Then
551 Begin
552 {$I-}
553 GetDir(0,NewDir);
554 {$I+}
555 End;
556
557 If Pos(':',NewDir)<>2 Then
558 Begin
559 {$I-}
560 GetDir(Ord(UpCase(Drive))-Ord('A')+1,s);
561 {$I+}
[213]562 If (s[length(s)])=DIRECTORY_SEPARATOR Then dec(s[0]);
563 If not (NewDir[1] In ['/',DIRECTORY_SEPARATOR]) Then s:=s+DIRECTORY_SEPARATOR;
[15]564 NewDir:=s+NewDir;
565 End;
566
[213]567 If NewDir[Length(NewDir)] = DIRECTORY_SEPARATOR Then SetLength(NewDir,Length(NewDir)-1);
[15]568 If FDirectory=NewDir Then exit;
569 FDirectory := NewDir;
570
571 If Handle<>0 Then BuildList;
572 Change;
573 If FDirList <> Nil Then
574 Begin
575 If uppercase(FDirList.Directory) <> uppercase(Directory)
576 Then FDirList.Directory := Directory;
577 End;
578
579End;
580
581
582Procedure TCustomFilelistBox.SetFileName(NewFile:String);
583Var Dir,Name,Ext:String;
584Begin
585 If GetFileName <> NewFile Then
586 Begin
587 FSplit(NewFile,Dir,Name,Ext);
588 If Dir='' Then
589 Begin
590 ItemIndex := Items.IndexOf(NewFile);
591 Change;
592 End
593 Else
594 Begin
595 SetDirectory(Dir);
596 SetFileName(Name+Ext);
597 End;
598 End;
599End;
600
601
602Function TCustomFilelistBox.GetFileName:String;
603Var idx:LongInt;
604 s:String;
605Begin
606 idx := ItemIndex;
607 If (idx < 0) Or (idx >= Items.Count) Then Result := ''
608 Else Result := Items[ idx ];
609 s:=Directory;
[213]610 If s[Length(s)] In [DIRECTORY_SEPARATOR,'/'] Then dec(s[0]);
611 If s<>'' Then If Result<>'' Then Result:=s+DIRECTORY_SEPARATOR+Result;
[15]612End;
613
614
615Procedure TCustomFilelistBox.SetMask(NewMask:String);
616Begin
617 If NewMask <> '' Then
618 Begin
619 If FMask=NewMask Then exit;
620 FMask := NewMask
621 End
622 Else
623 Begin
624 If FMask='*' Then exit;
625 FMask := '*';
626 End;
627
628 If Handle<>0 Then BuildList;
629 Change;
630End;
631
632Procedure TCustomFilelistBox.SetExcludeMask(NewMask:String);
633Begin
634 If FExcludeMask=NewMask Then
635 exit;
636 FExcludeMask := NewMask;
637 If Handle<>0 Then BuildList;
638 Change;
639End;
640
641Procedure TCustomFilelistBox.SetFileEdit(NewEdit:TEdit);
642Begin
643 FFileEdit := NewEdit;
644 If FFileEdit <> Nil Then
645 Begin
646 FFileEdit.FreeNotification(Self);
647 If FileName <> '' Then FFileEdit.Caption := FileName
648 Else FFileEdit.Caption := Mask;
649 End;
650End;
651
652
653Procedure TCustomFilelistBox.Notification(AComponent:TComponent;Operation:TOperation);
654Begin
655 Inherited Notification(AComponent,Operation);
656
657 If Operation = opRemove Then
658 If AComponent = FFileEdit Then FFileEdit := Nil;
659End;
660
661
662Procedure TCustomFilelistBox.SetFileType(Attr:TFileType);
663Begin
664 If FFileType <> Attr Then
665 Begin
666 FFileType := Attr;
667 If Handle<>0 Then BuildList;
668 Change;
669 End;
670End;
671
672
673Procedure TCustomFilelistBox.Change;
674Begin
675 If FFileEdit <> Nil Then
676 Begin
677 If FileName <> '' Then FFileEdit.Caption := FileName
678 Else FFileEdit.Caption := Mask;
679
680 FFileEdit.SelectAll;
681 End;
682
683 If FOnChange <> Nil Then FOnChange(Self);
684End;
685
686
687Function TCustomFilelistBox.WriteSCUResource(Stream:TResourceStream):Boolean;
688Begin
689 {don't Write contents To SCU}
690 Result := TControl.WriteSCUResource(Stream);
691End;
692
693Procedure TCustomFilelistBox.SetupShow;
694Begin
695 Inherited SetupShow;
696
697 BuildList;
698End;
699
700Procedure TCustomFilelistBox.Reload;
701Begin
702 StartUpdate;
703 If Handle<>0 Then BuildList;
704 CompleteUpdate;
705End;
706
707// ---------------------------------------------------------------------
708// CustomDirectoryListBox
709// ---------------------------------------------------------------------
710
711const
712 dfSubDir = 256;
713 dfErrorMessage = 512;
714
715Procedure TCustomDirectoryListBox.SetupComponent;
716Begin
717 Inherited SetupComponent;
718
719 Name := 'DirectoryListBox';
720
721 Directory := '';
722
723 Style:=lbOwnerDrawFixed;
724
725 FDriveCombo:= nil;
726
727 FPictureOpen:= TBitmap.Create;
728 FPictureOpen.LoadFromResourceName( 'FolderOpen' );
729 CreateMaskedBitmap( FPictureOpen, FPictureOpenMask, $ff00ff );
730
731 FPictureClosed:= TBitmap.Create;
732 FPictureClosed.LoadFromResourceName( 'FolderClosed' );
733 CreateMaskedBitmap( FPictureClosed, FPictureClosedMask, $ff00ff );
734End;
735
736Destructor TCustomDirectoryListBox.Destroy;
737begin
738 FPictureOpen.Free;
739 FPictureClosed.Free;
740 inherited Destroy;
741end;
742
743Procedure TCustomDirectoryListBox.MeasureItem(Index:LongInt;Var Width,Height:LongInt);
744Begin
745 Inherited MeasureItem(Index,Width,Height);
746 If Height<15 Then Height:=15;
747End;
748
749Procedure TCustomDirectoryListBox.DrawItem( Index: LongInt;
750 rec: TRect;
751 State: TOwnerDrawState );
752Var
753 X,Y,Y1,CX,CY,cx1,cy1:LongInt;
754 S: String;
755 Data: longint;
756 IndentLevel: longint;
757Begin
758 If State * [odSelected] <> [] Then
759 Begin
760 Canvas.Pen.color := clHighlightText;
761 Canvas.Brush.color := clHighlight;
762 End
763 Else
764 Begin
765 Canvas.Pen.color := PenColor;
766 Canvas.Brush.color := color;
767 End;
768 dec( rec.top ); // minor adjustments since we seem to get a slightly
769 inc( rec.left ); // incorrect area to draw on...
770
771 Canvas.FillRect(rec,Canvas.Brush.color);
772
773 X := rec.Left + 2;
774 Y := rec.Bottom + 1;
775 CX := rec.Right - X;
776 CY := rec.Top - Y;
777
778 S := '';
779 Data := 0;
780 if Index <> -1 then
781 begin
782 S := Items[ Index ];
783 Data:= longint( Items.Objects[ Index ] );
784 end;
785 IndentLevel:= Data and 255;
786
787 inc( X, IndentLevel * 5 );
788
789 Y1:=rec.Bottom+((CY- FPictureOpen.Height ) Div 2);
790 If Y1 < rec.Bottom+1 Then
791 Y1 := rec.Bottom+1;
792 inc(Y1);
793
794 if ( Data and dfErrorMessage ) > 0 Then
795 // error message - draw nothing
796
797 else if ( Data and dfSubDir ) > 0 Then
798 // subdir
799 DrawClosedFolder( X, Y1 )
800 else
801 // parent dir
802 DrawOpenFolder( X, Y1 );
803
804 inc( X, 5 );
805
806 Canvas.GetTextExtent(S,cx1,cy1);
807 Y := Y + ((CY - cy1) Div 2);
808 If Y < rec.Bottom Then
809 Y := rec.Bottom;
810 Canvas.Brush.Mode := bmTransparent;
811 Canvas.TextOut(X,Y,S);
812 Canvas.Brush.Mode := bmOpaque;
813End;
814
815Procedure TCustomDirectoryListBox.DrawOpenFolder( Var X: longint; Y: LongInt );
816Var
817 SaveBrushColor,SavePenColor:TColor;
818Begin
819 SaveBrushColor:=Canvas.Brush.Color;
820 SavePenColor:=Canvas.Pen.Color;
821
822 DrawMaskedBitmap( FPictureOpen,
823 FPictureOpenMask,
824 Canvas,
825 X, Y );
826
827 if FPictureOpen <> nil then
828 inc( X, FPictureOpen.Width );
829
830 Canvas.Brush.Color:=SaveBrushColor;
831 Canvas.Pen.Color:=SavePenColor;
832End;
833
834Procedure TCustomDirectoryListBox.DrawClosedFolder( Var X: longint; Y: LongInt );
835Var
836 SaveBrushColor,SavePenColor:TColor;
837Begin
838 SaveBrushColor:=Canvas.Brush.Color;
839 SavePenColor:=Canvas.Pen.Color;
840
841 DrawMaskedBitmap( FPictureClosed,
842 FPictureClosedMask,
843 Canvas,
844 X, Y );
845
846 if FPictureClosed <> nil then
847 inc( X, FPictureClosed.Width );
848
849 Canvas.Brush.Color:=SaveBrushColor;
850 Canvas.Pen.Color:=SavePenColor;
851End;
852
853Procedure TCustomDirectoryListBox.ItemSelect(Index:LongInt);
854Var
855 S: String;
856 Data: longint;
857 FullPath: string;
858Begin
859 If (Index < 0) Or (Index > Items.Count-1) Then Exit;
860
861 Data := longint( Items.Objects[ Index ] );
862 if ( Data and dfErrorMessage ) > 0 Then
863 Exit; // error item
864
865 FullPath:= Items[ Index ];
866 dec( Index );
867 while Index >= 0 do
868 begin
869 S := Items[ Index ];
870 Data:= longint( Items.Objects[ Index ] );
871 if ( Data and dfSubDir ) = 0 then
[188]872 FullPath:= AddDirectorySeparator( S ) + FullPath;
[15]873 dec( Index );
874 end;
875
876 Directory:= FullPath;
877
878 Inherited ItemSelect(Index);
879End;
880
881Procedure TCustomDirectoryListBox.BuildList;
882Var
883 S: String;
884 Search: TSearchRec;
885 Status: Integer;
886 Path: string;
887 SubDirs: TStringList;
888 IndentLevel: longint;
889 PathSoFar: string;
[213]890 tmpPathElements : TStringList;
891 i : integer;
[15]892Begin
893 Screen.Cursor := crHourGlass;
894 BeginUpdate;
895
896 IndentLevel:= 0;
897
898 // Add Drive
899 Items.Clear;
900 Items.AddObject( Drive+':\', pointer( IndentLevel ) );
901
902 DosErrorAPI( FERR_DISABLEHARDERR );
903
904 // Add all subdirs
905 Path := Copy( Directory, 4, 255 );
906 PathSoFar := Copy( Directory, 1, 3 );
[213]907
908 tmpPathElements := TStringList.Create;
909 StrExtractStrings(tmpPathElements, Path, [DIRECTORY_SEPARATOR], #0);
910
911 for i := 0 to tmpPathElements.Count - 1 do
912 begin
[15]913 inc( IndentLevel );
[213]914 S := tmpPathElements[i];
[15]915
916 if not DirectoryExists( PathSoFar + S ) then
917 begin
918 // directory specified doesn't exist.
919 FDirectory := PathSoFar;
920 break;
921 end;
922 Items.AddObject( S, pointer( IndentLevel ) );
[213]923 PathSoFar := PathSoFar + S + DIRECTORY_SEPARATOR;
[15]924 End;
925
[213]926 tmpPathElements.Destroy;
[15]927 ItemIndex:= Items.Count - 1;
928
929 inc( IndentLevel );
930
931 SubDirs:= TStringList.Create;
932
[188]933 Status := SysUtils.FindFirst( AddDirectorySeparator( Directory ) + '*.*', faDirectory, Search);
[15]934 While Status = 0 Do
935 Begin
936 S := Search.Name;
937 If Search.Attr And faDirectory = faDirectory Then
938 Begin
939 {avoid .. In Mainpath}
940 If ( S <> '.' )
941 and ( S <> '..' ) Then
942 SubDirs.AddObject( S, pointer( IndentLevel + dfSubDir ) );
943 End;
944 Status := SysUtils.FindNext( Search );
945 End;
946 if Status <> - ERROR_NO_MORE_FILES then
947 SubDirs.AddObject( '[Error reading directories]',
948 pointer( 1 + dfErrorMessage ) );
949
950 SysUtils.FindClose( Search );
951
952 DosErrorAPI( FERR_ENABLEHARDERR );
953
954 SubDirs.Sort;
955 Items.AddStrings( SubDirs );
956 SubDirs.Destroy;
957
958 EndUpdate;
959 Refresh;
960 Screen.Cursor := crDefault;
961End;
962
963
964Procedure TCustomDirectoryListBox.SetDirectory(NewDir:String);
965Var
966 s: String;
967Begin
968 If NewDir = '' Then
969 Begin
970 {$I-}
971 // Get current drive
972 GetDir(0,NewDir);
973 {$I+}
974 End;
975
976 If Pos(':',NewDir)<>2 Then
977 Begin
978 {$I-}
979 // Get current directory on specified drive
980 GetDir(Ord(UpCase(Drive))-Ord('A')+1,s);
981 {$I+}
[188]982 S:= RemoveRightDirectorySeparator( S );
983 S:= AddDirectorySeparator( S );
[15]984 NewDir:=s+NewDir;
985 End;
986
[188]987 NewDir:= RemoveRightDirectorySeparator( NewDir );
[15]988
989 FDirectory := NewDir;
990 if Handle <> 0 then
991 BuildList;
992
993 If FDriveCombo <> Nil Then
994 Begin
995 If UpCase( FDriveCombo.Drive ) <> UpCase( Drive ) Then
996 FDriveCombo.Drive := Drive;
997 End;
998
999 Change;
1000
1001End;
1002
1003
1004Procedure TCustomDirectoryListBox.SetDrive(NewDrive:Char);
1005Var NewDir:String;
1006Begin
1007 If UpCase(NewDrive) <> UpCase(Drive) Then
1008 Begin
1009 {Change To Current Directory At NewDrive}
1010 {$I-}
1011 GetDir(Ord(UpCase(NewDrive))-Ord('A')+1, NewDir);
1012 {$I+}
1013 If IOResult = 0 Then SetDirectory(NewDir);
1014 End;
1015End;
1016
1017
1018Function TCustomDirectoryListBox.GetDrive:Char;
1019Begin
1020 Result := FDirectory[1];
1021End;
1022
1023
1024Procedure TCustomDirectoryListBox.SetDirLabel(ALabel:TLabel);
1025Begin
1026 FDirLabel := ALabel;
1027 If FDirLabel <> Nil Then
1028 Begin
1029 FDirLabel.FreeNotification(Self);
1030 FDirLabel.Caption := FDirectory;
1031 End;
1032End;
1033
1034
1035Procedure TCustomDirectoryListBox.SetFileListBox(AFileList:TCustomFileListBox);
1036Begin
1037 If FFileList <> Nil Then FFileList.FDirList := Nil;
1038 FFileList := AFileList;
1039 If FFileList <> Nil Then
1040 Begin
1041 FFileList.FDirList := Self;
1042 FFileList.FreeNotification(Self);
1043 End;
1044End;
1045
1046
1047Procedure TCustomDirectoryListBox.Notification(AComponent:TComponent;Operation:TOperation);
1048Begin
1049 Inherited Notification(AComponent,Operation);
1050
1051 If Operation = opRemove Then
1052 Begin
1053 If AComponent = FFileList Then
1054 FFileList := Nil;
1055 If AComponent = FDirLabel Then
1056 FDirLabel := Nil;
1057 End;
1058End;
1059
1060
1061Procedure TCustomDirectoryListBox.Change;
1062Begin
1063 If FDirLabel <> Nil Then
1064 FDirLabel.Caption := FDirectory;
1065 If FFileList <> Nil Then
1066 FFileList.Directory := FDirectory;
1067
1068 If FOnChange <> Nil Then FOnChange(Self);
1069End;
1070
1071Function TCustomDirectoryListBox.WriteSCUResource(Stream:TResourceStream):Boolean;
1072Begin
1073 {don't Write contents To SCU}
1074 Result := TControl.WriteSCUResource(Stream);
1075End;
1076
1077Procedure TCustomDirectoryListBox.SetupShow;
1078Begin
1079 Inherited SetupShow;
1080
1081 BuildList;
1082End;
1083
1084Procedure TCustomDirectoryListBox.SetPictureClosed( NewBitmap: TBitmap );
1085Begin
1086 StoreBitmap( FPictureClosed, FPictureClosedMask, NewBitmap );
1087 Invalidate;
1088End;
1089
1090Procedure TCustomDirectoryListBox.SetPictureOpen( NewBitmap: TBitmap );
1091Begin
1092 StoreBitmap( FPictureOpen, FPictureOpenMask, NewBitmap );
1093 Invalidate;
1094End;
1095
1096// ---------------------------------------------------------------------
1097// TCustomDriveComboBox
1098// ---------------------------------------------------------------------
1099
1100Procedure TCustomDriveComboBox.SetupComponent;
1101Var
1102 DriveNumber: longint;
1103 CurrentDir: string;
1104
1105 DriveString: String;
1106 DriveType: TDriveType;
1107 DriveLabel: string;
1108
1109Begin
1110 Inherited SetupComponent;
1111
1112 Name := 'DriveComboBox';
1113 Style := csDropDownList;
1114 sorted := False;
1115
1116 OwnerDraw := true;
1117 OnDrawItem := DrawItem;
1118
1119 {Fill Drive Combo}
1120
1121 For DriveNumber := MinDriveNumber To MaxDriveNumber Do
1122 begin
1123 DriveType := GetDriveType( DriveNumber );
1124 DriveString := Chr( DriveNumber + Ord( 'A' ) - 1 ) + ': ';
1125
1126 if DriveType <> dtNone then
1127 begin
1128 if DriveType = dtHard then
1129 begin
1130 try
[188]1131 DriveLabel := GetVolumeLabel( DriveNumberToDriveLetter( DriveNumber ) );
[15]1132 DriveString := DriveString + DriveLabel;
1133 except
1134 end;
1135 end;
1136
1137 if DriveType = dtNetwork then
1138 begin
1139 if not Designed then
1140 begin
1141 DriveString := DriveString
1142 + LowerCase( GetNetworkDriveRemotePath( DriveNumber ) );
1143 end;
1144 end;
1145
1146 Items.AddObject( DriveString, TObject( DriveType ) );
1147 end;
1148 end;
1149
1150 // Get current drive
1151 try
1152 GetDir( 0, CurrentDir );
1153 Drive := CurrentDir[ 1 ];
1154 except
1155 on EInOutError do
1156 // Current drive inaccessible
[188]1157 Drive := GetBootDriveLetter;
[15]1158 end;
1159End;
1160
1161Procedure TCustomDriveComboBox.DrawItem( Canvas: TCanvas;
1162 S: string;
1163 Data: TObject;
1164 rec: TRect;
1165 State: TOwnerDrawState );
1166Var
1167 X,Y,CX,CY: LongInt;
1168 DriveType: TDriveType;
1169 DrivePath: string;
1170 TypeBitmap: TBitmap;
1171 TypeBitmapMask: TBitmap;
1172 TextHeight: longint;
1173 TextWidth: longint;
1174 TextBottom: longint;
1175 BitmapBottom: longint;
1176Begin
1177 If odSelected in State Then
1178 Begin
1179 Canvas.Pen.color := clHighlightText;
1180 Canvas.Brush.color := clHighlight;
1181 End
1182 Else
1183 Begin
1184 Canvas.Pen.color := PenColor;
1185 Canvas.Brush.color := Color;
1186 End;
1187 Canvas.FillRect(rec,Canvas.Brush.color);
1188
1189 X := rec.Left + 2;
1190 Y := rec.Bottom + 1;
1191 CX := rec.Right - X;
1192 CY := rec.Top - Y;
1193
1194 DrivePath := Copy( S, 1, 2 ); // "a:"
1195 Delete( S, 1, 3 ); // delete "a: "
1196
1197 DriveType := TDriveType( Data );
1198 TypeBitmap := DriveTypeBitmaps[ DriveType ];
1199 TypeBitmapMask := DriveTypeBitmapMasks[ DriveType ];
1200
1201 // see how high the text is, and the widest (W)
1202 Canvas.GetTextExtent( 'W: ', TextWidth, TextHeight );
1203
1204 TextBottom := Y + ( CY - TextHeight ) div 2;
1205 if TextBottom < rec.Bottom then
1206 TextBottom := rec.Bottom;
1207
1208 BitmapBottom := Y + ( CY - TypeBitmap.Height ) div 2;
1209 if BitmapBottom < rec.Bottom then
1210 BitmapBottom := rec.Bottom;
1211
1212 // Draw drive type image
1213 DrawMaskedBitmap( TypeBitmap, TypeBitmapMask,
1214 Canvas,
1215 X, BitmapBottom );
1216 inc( X, TypeBitmap.Width );
1217 inc( X, 5 );
1218
1219 // Draw drive letter
1220 Canvas.TextOut( X, TextBottom, DrivePath );
1221 inc( X, TextWidth );
1222
1223 Canvas.TextOut( X, TextBottom, S );
1224end;
1225
1226Procedure TCustomDriveComboBox.ItemSelect(Index:LongInt);
1227Begin
1228 Inherited ItemSelect(Index);
1229
1230 Change;
1231End;
1232
1233
1234Procedure TCustomDriveComboBox.Change;
1235var
1236 DriveLabel: string;
1237 DriveValid: boolean;
1238 DriveType: TDriveType;
1239Begin
1240 {determine volume label}
1241 If ItemIndex <> -1 Then
1242 Begin
1243 DriveValid := false;
1244 DriveType := TDriveType( Items.Objects[ ItemIndex ] );
1245 while not DriveValid do
1246 begin
1247 try
1248 Screen.Cursor := crHourGlass;
1249
1250 DriveLabel := GetVolumeLabel( Text[1] );
1251 DriveValid := true;
1252
1253 if DriveType <> dtNetwork then
1254 begin
1255 Text := Copy( Text, 1, 3 ) + DriveLabel;
1256 Items[ ItemIndex ] := Text;
1257 end;
1258 except
1259 on E: EInOutError do
1260 begin
1261 DriveValid := false;
1262 Screen.Cursor := crDefault;
1263 if MessageBox( e.Message,
1264 mtError,
1265 [ mbRetry, mbCancel ] ) = mrCancel then
1266 begin
1267 // Cancelling: back to last.
1268 // Actually it could be that the original drive is now
1269 // invalid... :|
1270 if ItemIndex = FLastIndex then
1271 begin
1272 // we were trying to re-read the
1273 // current drive, and it failed,
1274 // and the user doesn't want to retry,
1275 // so go back to boot drive.
[188]1276 SetDrive(GetBootDriveLetter);
[15]1277 Screen.Cursor := crDefault;
1278 Exit;
1279 end;
1280 ItemIndex := FLastIndex;
1281 DriveValid := true;
1282 end;
1283 end;
1284 end;
1285 end;
1286 End;
1287 Screen.Cursor := crDefault;
1288
1289 FLastIndex := ItemIndex;
1290
1291 If FDirList <> Nil Then FDirList.Drive := Drive;
1292
1293 If FOnChange <> Nil Then FOnChange(Self);
1294
1295End;
1296
1297Function TCustomDriveComboBox.GetDrive:Char;
1298Begin
1299 Result := Text[1];
1300End;
1301
1302Procedure TCustomDriveComboBox.SetDrive(NewDrive:Char);
1303Var S:String;
1304 T:LongInt;
1305 {$IFDEF Win95}
1306 sernum,complen,Flags:LongWord;
1307 FileSystem,volname:cstring;
1308 {$ENDIF}
1309Begin
1310 NewDrive := UpCase(NewDrive);
1311 If UpCase(Drive) = NewDrive Then Exit;
1312
1313 // Find the drive in the list
1314 For T := 0 To Items.Count-1 Do
1315 Begin
1316 S := Items.Strings[T];
1317 If UpCase(S[1]) = NewDrive Then
1318 Begin
1319 // Found
1320 ItemIndex := T;
1321 break;
1322 End;
1323 End;
1324End;
1325
1326
1327Procedure TCustomDriveComboBox.SetDirListBox(ADirList:TCustomDirectoryListBox);
1328Begin
1329 If FDirList <> Nil Then FDirList.FDriveCombo := Nil;
1330 FDirList := ADirList;
1331 If FDirList <> Nil Then
1332 Begin
1333 FDirList.FDriveCombo := Self;
1334 FDirList.FreeNotification(Self);
1335 End;
1336End;
1337
1338
1339Procedure TCustomDriveComboBox.Notification(AComponent:TComponent;Operation:TOperation);
1340Begin
1341 Inherited Notification(AComponent,Operation);
1342
1343 If Operation = opRemove Then
1344 If AComponent = FDirList Then
1345 FDirList := Nil;
1346End;
1347
1348
1349Function TCustomDriveComboBox.WriteSCUResource(Stream:TResourceStream):Boolean;
1350Begin
1351 {don't Write contents To SCU}
1352 Result := TControl.WriteSCUResource(Stream);
1353End;
1354
1355
1356// ---------------------------------------------------------------------
1357// TCustomFilterComboBox
1358// ---------------------------------------------------------------------
1359
1360Procedure TCustomFilterComboBox.SetupComponent;
1361Begin
1362 Inherited SetupComponent;
1363
1364 Name := 'FilterComboBox';
1365 Style := csDropDownList;
1366 sorted := False;
1367
1368 FFilter := LoadNLSStr(SAllFiles)+' (*.*)|*.*';
1369 FMaskList.Create;
1370End;
1371
1372
1373Procedure TCustomFilterComboBox.SetupShow;
1374Begin
1375 Inherited SetupShow;
1376
1377 BuildList;
1378End;
1379
1380
1381Destructor TCustomFilterComboBox.Destroy;
1382Begin
1383 FMaskList.Destroy;
1384 FMaskList := Nil;
1385
1386 Inherited Destroy;
1387End;
1388
1389
1390Procedure TCustomFilterComboBox.ItemSelect(Index:LongInt);
1391Begin
1392 Inherited ItemSelect(Index);
1393
1394 Text := Items[Index];
1395 Change;
1396End;
1397
1398
1399Procedure TCustomFilterComboBox.Change;
1400Begin
1401 If FFileList <> Nil Then FFileList.Mask := Mask;
1402
1403 If FOnChange <> Nil Then FOnChange(Self);
1404End;
1405
1406
1407Procedure TCustomFilterComboBox.BuildList;
1408Var AMask,AFilter:String;
1409 S:String;
1410 P:Integer;
1411Begin
1412 BeginUpdate;
1413 Clear;
1414 FMaskList.Clear;
1415
1416 S := FFilter;
1417 P := Pos('|',S);
1418 While P > 0 Do
1419 Begin
1420 AFilter := Copy(S,1,P-1);
1421 Delete(S,1,P);
1422 P := Pos('|',S);
1423 If P > 0 Then
1424 Begin
1425 AMask := Copy(S,1,P-1);
1426 Delete(S,1,P);
1427 End
1428 Else
1429 Begin
1430 AMask := S;
1431 S := '';
1432 End;
1433 Items.Add(AFilter);
1434 FMaskList.Add(AMask);
1435 P := Pos('|',S);
1436 End;
1437 EndUpdate;
1438 if Items.Count > 0 then
1439 ItemIndex := 0;
1440End;
1441
1442
1443Procedure TCustomFilterComboBox.SetFilter(NewFilter:String);
1444Begin
1445 If FFilter <> NewFilter Then
1446 Begin
1447 FFilter := NewFilter;
1448 BuildList;
1449 Change;
1450 End;
1451End;
1452
1453
1454Procedure TCustomFilterComboBox.SetFilelistBox(AFileList:TCustomFilelistBox);
1455Begin
1456 If FFileList <> Nil Then FFileList.FFilterCombo := Nil;
1457 FFileList := AFileList;
1458 If FFileList <> Nil Then
1459 Begin
1460 FFileList.FFilterCombo := Self;
1461 FFileList.FreeNotification(Self);
1462 End;
1463End;
1464
1465
1466Procedure TCustomFilterComboBox.Notification(AComponent:TComponent;Operation:TOperation);
1467Begin
1468 Inherited Notification(AComponent,Operation);
1469
1470 If Operation = opRemove Then
1471 If AComponent = FFileList Then FFileList := Nil;
1472End;
1473
1474
1475Function TCustomFilterComboBox.GetMask:String;
1476Var idx:LongInt;
1477Begin
1478 idx := ItemIndex;
1479 If (idx < 0) Or (idx >= FMaskList.Count) Then Result := '*.*'
1480 Else Result := FMaskList[idx];
1481End;
1482
1483
1484Function TCustomFilterComboBox.WriteSCUResource(Stream:TResourceStream):Boolean;
1485Begin
1486 {don't Write contents To SCU}
1487 Result := TControl.WriteSCUResource(Stream);
1488End;
1489
1490var
1491 DriveType: TDriveType;
1492 ResourceName: string;
1493 Bitmap: TBitmap;
1494 MaskBitmap: TBitmap;
1495Initialization
1496 RegisterClasses( [ TCustomDriveComboBox,
1497 TCustomDirectoryListBox,
1498 TCustomFilelistBox,
1499 TCustomFilterComboBox ] );
1500
1501 for DriveType := Low( TDriveType ) to High( TDriveType ) do
1502 begin
1503 if DriveType = dtNone then
1504 begin
1505 DriveTypeBitmaps[ DriveType ] := nil;
1506 DriveTypeBitmapMasks[ DriveType ] := nil;
1507 continue; // don't load a bitmap for the none
1508 end;
1509
1510 ResourceName := DriveTypeBitmapNames[ DriveType ];
1511
1512 Bitmap:= TBitmap.Create;
1513 Bitmap.LoadFromResourceName( ResourceName );
1514 DriveTypeBitmaps[ DriveType ] := Bitmap;
1515
1516 MaskBitmap:= TBitmap.Create;
1517 CreateMaskedBitmap( Bitmap, MaskBitmap, $ff00ff );
1518 DriveTypeBitmapMasks[ DriveType ] := MaskBitmap;
1519 end;
1520
1521finalization
1522
1523 for DriveType := Low( TDriveType ) to High( TDriveType ) do
1524 begin
1525 if DriveTypeBitmaps[ DriveType ] <> nil then
1526 DriveTypeBitmaps[ DriveType ].Destroy;
1527
1528 if DriveTypeBitmapMasks[ DriveType ] <> nil then
1529 DriveTypeBitmapMasks[ DriveType ].Destroy;
1530 end;
1531
1532End.
1533
1534
Note: See TracBrowser for help on using the repository browser.