home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Dirselct / DIRSELCT.PAS < prev    next >
Pascal/Delphi Source File  |  1995-06-06  |  3KB  |  124 lines
  1. { Form Template - Source and Destination Choices Lists }
  2. unit Dirselct;
  3.  
  4. interface
  5.  
  6. uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
  7.   StdCtrls, FileCtrl;
  8.  
  9. type
  10.   TDirSelectDlg = class(TForm)
  11.     OKBtn: TBitBtn;
  12.     CancelBtn: TBitBtn;
  13.     HelpBtn: TBitBtn;
  14.     DestList: TListBox;
  15.     SrcLabel: TLabel;
  16.     DstLabel: TLabel;
  17.     IncludeBtn: TSpeedButton;
  18.     ExcludeBtn: TSpeedButton;
  19.     ExAllBtn: TSpeedButton;
  20.     DirList: TDirectoryListBox;
  21.     DriveComboBox1: TDriveComboBox;
  22.     procedure IncludeBtnClick(Sender: TObject);
  23.     procedure ExcludeBtnClick(Sender: TObject);
  24.     procedure ExcAllBtnClick(Sender: TObject);
  25.     procedure RemoveSelected(List: TCustomListBox);
  26.     procedure MoveSelected(List: TDirectoryListBox; DestList: TCustomListBox);
  27.     procedure SetItem(List: TListBox; Index: Integer);
  28.     function GetFirstSelection(List: TCustomListBox): Integer;
  29.     procedure SetButtons;
  30.   private
  31.     { Private declarations }
  32.   public
  33.     { Public declarations }
  34.   end;
  35.  
  36. var
  37.   DirSelectDlg: TDirSelectDlg;
  38.  
  39. implementation
  40.  
  41. {$R *.DFM}
  42.  
  43. procedure TDirSelectDlg.IncludeBtnClick(Sender: TObject);
  44. var
  45.   Index: Integer;
  46. begin
  47.   Index := GetFirstSelection(DirList);
  48.   MoveSelected(DirList,DestList);
  49.   SetButtons;
  50. end;
  51.  
  52. procedure TDirSelectDlg.ExcludeBtnClick(Sender: TObject);
  53. var
  54.   Index: Integer;
  55. begin
  56.   Index := GetFirstSelection(DestList);
  57.   RemoveSelected(DestList);
  58.   SetItem(DestList, Index);
  59. end;
  60.  
  61. procedure TDirSelectDlg.ExcAllBtnClick(Sender: TObject);
  62. begin
  63.   DestList.Items.Clear;
  64.   SetItem(DestList, 0);
  65. end;
  66.  
  67. procedure TDirSelectDlg.RemoveSelected(List: TCustomListBox);
  68. var
  69.   I: Integer;
  70. begin
  71.   for I := List.Items.Count - 1 downto 0 do
  72.     if List.Selected[I] then
  73.     begin
  74.        List.Items.Delete(I);
  75.     end;
  76. end;
  77.  
  78. procedure TDirSelectDlg.MoveSelected(List: TDirectoryListBox; DestList: TCustomListBox);
  79. var
  80.   I: Integer;
  81. begin
  82.   for I := List.Items.Count - 1 downto 0 do
  83.     if List.Selected[I] then
  84.     begin
  85.        if DestList.Items.IndexOf(List.GetItemPath(I)) = -1 then
  86.               DestList.Items.Add(List.GetItemPath(I));
  87.     end;
  88. end;
  89.  
  90. procedure TDirSelectDlg.SetButtons;
  91. var
  92.   SrcEmpty, DstEmpty: Boolean;
  93. begin
  94.   DstEmpty := DestList.Items.Count = 0;
  95.   IncludeBtn.Enabled := True;
  96.   ExcludeBtn.Enabled := not DstEmpty;
  97.   ExAllBtn.Enabled := not DstEmpty;
  98. end;
  99.  
  100. function TDirSelectDlg.GetFirstSelection(List: TCustomListBox): Integer;
  101. begin
  102.   for Result := 0 to List.Items.Count - 1 do
  103.     if List.Selected[Result] then Exit;
  104.   Result := LB_ERR;
  105. end;
  106.  
  107. procedure TDirSelectDlg.SetItem(List: TListBox; Index: Integer);
  108. var
  109.   MaxIndex: Integer;
  110. begin
  111.   with List do
  112.   begin
  113.     SetFocus;
  114.     MaxIndex := List.Items.Count - 1;
  115.     if Index = LB_ERR then Index := 0
  116.     else if Index > MaxIndex then Index := MaxIndex;
  117.     Selected[Index] := True;
  118.   end;
  119.   SetButtons;
  120. end;
  121.  
  122.  
  123. end.
  124.