home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SOURCE.DAT / SOURCE / SPCC / FILECTRL.PAS < prev    next >
Pascal/Delphi Source File  |  1998-05-06  |  37KB  |  1,309 lines
  1.  
  2. {╔══════════════════════════════════════════════════════════════════════════╗
  3.  ║                                                                          ║
  4.  ║     Sibyl Portable Component Classes                                     ║
  5.  ║                                                                          ║
  6.  ║     Copyright (C) 1995,97 SpeedSoft Germany,   All rights reserved.      ║
  7.  ║                                                                          ║
  8.  ╚══════════════════════════════════════════════════════════════════════════╝}
  9.  
  10. Unit FileCtrl;
  11.  
  12. Interface
  13.  
  14. Uses Dos,SysUtils,Classes,Forms,StdCtrls;
  15.  
  16.  
  17. Type
  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.  
  352. Function InsertFileListBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TFileListBox;
  353. Function InsertDirectoryListBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TDirectoryListBox;
  354. Function InsertDriveComboBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TDriveComboBox;
  355. Function InsertFilterComboBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TFilterComboBox;
  356.  
  357.  
  358. Implementation
  359.  
  360. {$IFDEF OS2}
  361. Uses BseDos;
  362. {$ENDIF}
  363.  
  364. {$IFDEF Win95}
  365. Uses WinBase;
  366. {$ENDIF}
  367.  
  368.  
  369. Function InsertFileListBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TFileListBox;
  370. Begin
  371.      Result.Create(parent);
  372.      Result.SetWindowPos(Left,Bottom,Width,Height);
  373.      Result.parent := parent;
  374. End;
  375.  
  376.  
  377. Function InsertDirectoryListBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TDirectoryListBox;
  378. Begin
  379.      Result.Create(parent);
  380.      Result.SetWindowPos(Left,Bottom,Width,Height);
  381.      Result.parent := parent;
  382. End;
  383.  
  384.  
  385. Function InsertDriveComboBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TDriveComboBox;
  386. Begin
  387.      Result.Create(parent);
  388.      Result.SetWindowPos(Left,Bottom,Width,Height);
  389.      Result.parent := parent;
  390. End;
  391.  
  392.  
  393. Function InsertFilterComboBox(parent:TControl;Left,Bottom,Width,Height:LongInt):TFilterComboBox;
  394. Begin
  395.      Result.Create(parent);
  396.      Result.SetWindowPos(Left,Bottom,Width,Height);
  397.      Result.parent := parent;
  398. End;
  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.  
  415. Procedure TFileListBox.SetupComponent;
  416. Begin
  417.      Inherited SetupComponent;
  418.  
  419.      Name := 'FileListBox';
  420.      Sorted := True;
  421.      FFileType := [ftNormal];
  422.      Mask := '';
  423.      Directory := '';
  424. End;
  425.  
  426.  
  427. Procedure TFileListBox.ItemFocus(Index:LongInt);
  428. Begin
  429.      Inherited ItemFocus(Index);
  430.  
  431.      Change;
  432. End;
  433.  
  434.  
  435. Procedure TFileListBox.BuildList;
  436. {$IFDEF OS2}
  437. Const AttrSet:Array[TFileAttr] Of Word = (faReadOnly,faHidden,faSysFile,0,faDirectory,faArchive,0);
  438. {$ENDIF}
  439. {$IFDEF WIN32}
  440. Const AttrSet:Array[TFileAttr] Of Word = (faReadOnly,faHidden,faSysFile,0,faDirectory,faArchive,faArchive);
  441. {$ENDIF}
  442. Var  Search:TSearchRec;
  443.      Status:Integer;
  444.      Attr:Word;
  445.      AttrIndex:TFileAttr;
  446.      S,s1:String;
  447. Begin
  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;
  490. End;
  491.  
  492.  
  493. Function TFileListBox.GetDrive:Char;
  494. Begin
  495.      Result := FDirectory[1];
  496. End;
  497.  
  498.  
  499. Procedure TFileListBox.SetDrive(NewDrive:Char);
  500. Var  NewDir:String;
  501. Begin
  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;
  510. End;
  511.  
  512. Procedure TFileListBox.SetDirectory(NewDir:String);
  513. Var s:String;
  514. Begin
  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;
  544. End;
  545.  
  546.  
  547. Procedure TFileListBox.SetFileName(NewFile:String);
  548. Var Dir,Name,Ext:String;
  549. Begin
  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;
  564. End;
  565.  
  566.  
  567. Function TFileListBox.GetFileName:String;
  568. Var  idx:LongInt;
  569.      s:String;
  570. Begin
  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;
  577. End;
  578.  
  579.  
  580. Procedure TFileListBox.SetMask(NewMask:String);
  581. Begin
  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;
  595. End;
  596.  
  597.  
  598. Procedure TFileListBox.SetFileEdit(NewEdit:TEdit);
  599. Begin
  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;
  607. End;
  608.  
  609.  
  610. Procedure TFileListBox.Notification(AComponent:TComponent;Operation:TOperation);
  611. Begin
  612.      Inherited Notification(AComponent,Operation);
  613.  
  614.      If Operation = opRemove Then
  615.        If AComponent = FFileEdit Then FFileEdit := Nil;
  616. End;
  617.  
  618.  
  619. Procedure TFileListBox.SetFileType(Attr:TFileType);
  620. Begin
  621.      If FFileType <> Attr Then
  622.      Begin
  623.           FFileType := Attr;
  624.           If Handle<>0 Then BuildList;
  625.           Change;
  626.      End;
  627. End;
  628.  
  629.  
  630. Procedure TFileListBox.Change;
  631. Begin
  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);
  641. End;
  642.  
  643.  
  644. Function TFileListBox.WriteSCUResource(Stream:TResourceStream):Boolean;
  645. Begin
  646.      {don't Write contents To SCU}
  647.      Result := TControl.WriteSCUResource(Stream);
  648. End;
  649.  
  650. Procedure TFileListBox.SetupShow;
  651. Begin
  652.      Inherited SetupShow;
  653.  
  654.      BuildList;
  655. End;
  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.  
  672. Procedure TDirectoryListBox.SetupComponent;
  673. Begin
  674.      Inherited SetupComponent;
  675.  
  676.      Name := 'DirectoryListBox';
  677.      sorted := True;
  678.      Directory := '';
  679.      Style:=lbOwnerDrawFixed;
  680. End;
  681.  
  682. Procedure TDirectoryListBox.MeasureItem(Index:LongInt;Var Width,Height:LongInt);
  683. Begin
  684.    Inherited MeasureItem(Index,Width,Height);
  685.    If Height<15 Then Height:=15;
  686. End;
  687.  
  688. Procedure TDirectoryListBox.DrawItem(Index:LongInt;rec:TRect;State:TOwnerDrawState);
  689. Var X,Y,Y1,CX,CY,cx1,cy1:LongInt;
  690.     S,Dir,Dir1:String;
  691.     t:LongInt;
  692. Begin
  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;
  742. End;
  743.  
  744. Procedure TDirectoryListBox.DrawOpenFolder(X,Y:LongInt);
  745. Var SaveBrushColor,SavePenColor:TColor;
  746. Begin
  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;
  778. End;
  779.  
  780. Procedure TDirectoryListBox.DrawClosedFolder(X,Y:LongInt);
  781. Var SaveBrushColor,SavePenColor:TColor;
  782. Begin
  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;
  807. End;
  808.  
  809. Procedure TDirectoryListBox.ItemSelect(Index:LongInt);
  810. Var S,S1:String;
  811.     t:LongInt;
  812. Begin
  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;
  831. End;
  832.  
  833. Procedure TDirectoryListBox.BuildList;
  834. Var  S,S1:String;
  835.      Search:TSearchRec;
  836.      Status:Integer;
  837.      b:Byte;
  838.      t:LongInt;
  839.      Dir:String;
  840. Begin
  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;
  886. End;
  887.  
  888.  
  889. Procedure TDirectoryListBox.SetDirectory(NewDir:String);
  890. Var s:String;
  891. Begin
  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;
  922. End;
  923.  
  924.  
  925. Procedure TDirectoryListBox.SetDrive(NewDrive:Char);
  926. Var  NewDir:String;
  927. Begin
  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;
  936. End;
  937.  
  938.  
  939. Function TDirectoryListBox.GetDrive:Char;
  940. Begin
  941.      Result := FDirectory[1];
  942. End;
  943.  
  944.  
  945. Procedure TDirectoryListBox.SetDirLabel(ALabel:TLabel);
  946. Begin
  947.      FDirLabel := ALabel;
  948.      If FDirLabel <> Nil Then
  949.      Begin
  950.           FDirLabel.FreeNotification(Self);
  951.           FDirLabel.Caption := FDirectory;
  952.      End;
  953. End;
  954.  
  955.  
  956. Procedure TDirectoryListBox.SetFileListBox(AFileList:TFileListBox);
  957. Begin
  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;
  965. End;
  966.  
  967.  
  968. Procedure TDirectoryListBox.Notification(AComponent:TComponent;Operation:TOperation);
  969. Begin
  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;
  977. End;
  978.  
  979.  
  980. Procedure TDirectoryListBox.Change;
  981. Begin
  982.      If FDirLabel <> Nil Then FDirLabel.Caption := FDirectory;
  983.      If FFileList <> Nil Then FFileList.Directory := FDirectory;
  984.  
  985.      If FOnChange <> Nil Then FOnChange(Self);
  986. End;
  987.  
  988.  
  989. Function TDirectoryListBox.WriteSCUResource(Stream:TResourceStream):Boolean;
  990. Begin
  991.      {don't Write contents To SCU}
  992.      Result := TControl.WriteSCUResource(Stream);
  993. End;
  994.  
  995. Procedure TDirectoryListBox.SetupShow;
  996. Begin
  997.      Inherited SetupShow;
  998.  
  999.      BuildList;
  1000. End;
  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.  
  1017. Procedure TDriveComboBox.SetupComponent;
  1018. Var  DriveMap:LongWord;
  1019.      SDrive:Byte;
  1020.      actdir:String;
  1021.      {$IFDEF OS2}
  1022.      ActualDrive:LongWord;
  1023.      {$ENDIF}
  1024. Begin
  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];
  1051. End;
  1052.  
  1053.  
  1054. Procedure TDriveComboBox.ItemSelect(Index:LongInt);
  1055. Var  S:String;
  1056. Begin
  1057.      Inherited ItemSelect(Index);
  1058.  
  1059.      S := Text;
  1060.      If S <> '' Then Drive := S[1];
  1061. End;
  1062.  
  1063.  
  1064. Procedure TDriveComboBox.Change;
  1065. Begin
  1066.      If FDirList <> Nil Then FDirList.Drive := FDrive;
  1067.  
  1068.      If FOnChange <> Nil Then FOnChange(Self);
  1069. End;
  1070.  
  1071.  
  1072. Procedure TDriveComboBox.SetDrive(NewDrive:Char);
  1073. Var 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}
  1081. Label L;
  1082. Begin
  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;
  1101. L:
  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;
  1130. End;
  1131.  
  1132.  
  1133. Procedure TDriveComboBox.SetDirListBox(ADirList:TDirectoryListBox);
  1134. Begin
  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;
  1142. End;
  1143.  
  1144.  
  1145. Procedure TDriveComboBox.Notification(AComponent:TComponent;Operation:TOperation);
  1146. Begin
  1147.      Inherited Notification(AComponent,Operation);
  1148.  
  1149.      If Operation = opRemove Then
  1150.        If AComponent = FDirList Then FDirList := Nil;
  1151. End;
  1152.  
  1153.  
  1154. Function TDriveComboBox.WriteSCUResource(Stream:TResourceStream):Boolean;
  1155. Begin
  1156.      {don't Write contents To SCU}
  1157.      Result := TControl.WriteSCUResource(Stream);
  1158. End;
  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.  
  1175. Procedure TFilterComboBox.SetupComponent;
  1176. Begin
  1177.      Inherited SetupComponent;
  1178.  
  1179.      Name := 'FilterComboBox';
  1180.      Style := csDropDownList;
  1181.      sorted := False;
  1182.  
  1183.      FFilter := LoadNLSStr(SAllFiles)+' (*.*)|*.*';
  1184.      FMaskList.Create;
  1185. End;
  1186.  
  1187.  
  1188. Procedure TFilterComboBox.SetupShow;
  1189. Begin
  1190.      Inherited SetupShow;
  1191.  
  1192.      BuildList;
  1193. End;
  1194.  
  1195.  
  1196. Destructor TFilterComboBox.Destroy;
  1197. Begin
  1198.      FMaskList.Destroy;
  1199.      FMaskList := Nil;
  1200.  
  1201.      Inherited Destroy;
  1202. End;
  1203.  
  1204.  
  1205. Procedure TFilterComboBox.ItemSelect(Index:LongInt);
  1206. Begin
  1207.      Inherited ItemSelect(Index);
  1208.  
  1209.      Text := Items[Index];
  1210.      Change;
  1211. End;
  1212.  
  1213.  
  1214. Procedure TFilterComboBox.Change;
  1215. Begin
  1216.      If FFileList <> Nil Then FFileList.Mask := Mask;
  1217.  
  1218.      If FOnChange <> Nil Then FOnChange(Self);
  1219. End;
  1220.  
  1221.  
  1222. Procedure TFilterComboBox.BuildList;
  1223. Var  AMask,AFilter:String;
  1224.      S:String;
  1225.      P:Integer;
  1226. Begin
  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;
  1254. End;
  1255.  
  1256.  
  1257. Procedure TFilterComboBox.SetFilter(NewFilter:String);
  1258. Begin
  1259.      If FFilter <> NewFilter Then
  1260.      Begin
  1261.           FFilter := NewFilter;
  1262.           BuildList;
  1263.           Change;
  1264.      End;
  1265. End;
  1266.  
  1267.  
  1268. Procedure TFilterComboBox.SetFileListBox(AFileList:TFileListBox);
  1269. Begin
  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;
  1277. End;
  1278.  
  1279.  
  1280. Procedure TFilterComboBox.Notification(AComponent:TComponent;Operation:TOperation);
  1281. Begin
  1282.      Inherited Notification(AComponent,Operation);
  1283.  
  1284.      If Operation = opRemove Then
  1285.        If AComponent = FFileList Then FFileList := Nil;
  1286. End;
  1287.  
  1288.  
  1289. Function TFilterComboBox.GetMask:String;
  1290. Var  idx:LongInt;
  1291. Begin
  1292.      idx := ItemIndex;
  1293.      If (idx < 0) Or (idx >= FMaskList.Count) Then Result := '*.*'
  1294.      Else Result := FMaskList[idx];
  1295. End;
  1296.  
  1297.  
  1298. Function TFilterComboBox.WriteSCUResource(Stream:TResourceStream):Boolean;
  1299. Begin
  1300.      {don't Write contents To SCU}
  1301.      Result := TControl.WriteSCUResource(Stream);
  1302. End;
  1303.  
  1304.  
  1305. Begin
  1306. End.
  1307.  
  1308.  
  1309.