home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Objrepos / DUALLIST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  3.0 KB  |  129 lines
  1. unit DualList;
  2.  
  3. interface
  4.  
  5. uses 
  6.   Windows, Messages, SysUtils, Classes, Graphics, Forms, Dialogs, Controls, StdCtrls, 
  7.   Buttons;
  8.  
  9. type
  10.   TDualListDlg = class(TForm)
  11.     OKBtn: TButton;
  12.     CancelBtn: TButton;
  13.     HelpBtn: TButton;
  14.     SrcList: TListBox;
  15.     DstList: TListBox;
  16.     SrcLabel: TLabel;
  17.     DstLabel: TLabel;
  18.     IncludeBtn: TSpeedButton;
  19.     IncAllBtn: TSpeedButton;
  20.     ExcludeBtn: TSpeedButton;
  21.     ExAllBtn: TSpeedButton;
  22.     procedure IncludeBtnClick(Sender: TObject);
  23.     procedure ExcludeBtnClick(Sender: TObject);
  24.     procedure IncAllBtnClick(Sender: TObject);
  25.     procedure ExcAllBtnClick(Sender: TObject);
  26.   private
  27.     { Private declarations }
  28.   public
  29.     { Public declarations }
  30.     procedure MoveSelected(List: TCustomListBox; Items: TStrings);
  31.     procedure SetItem(List: TListBox; Index: Integer);
  32.     function GetFirstSelection(List: TCustomListBox): Integer;
  33.     procedure SetButtons;
  34.   end;
  35.  
  36. var
  37.   DualListDlg: TDualListDlg;
  38.  
  39. implementation
  40.  
  41. {$R *.DFM}
  42.  
  43. procedure TDualListDlg.IncludeBtnClick(Sender: TObject);
  44. var
  45.   Index: Integer;
  46. begin
  47.   Index := GetFirstSelection(SrcList);
  48.   MoveSelected(SrcList, DstList.Items);
  49.   SetItem(SrcList, Index);
  50. end;
  51.  
  52. procedure TDualListDlg.ExcludeBtnClick(Sender: TObject);
  53. var
  54.   Index: Integer;
  55. begin
  56.   Index := GetFirstSelection(DstList);
  57.   MoveSelected(DstList, SrcList.Items);
  58.   SetItem(DstList, Index);
  59. end;
  60.  
  61. procedure TDualListDlg.IncAllBtnClick(Sender: TObject);
  62. var
  63.   I: Integer;
  64. begin
  65.   for I := 0 to SrcList.Items.Count - 1 do
  66.     DstList.Items.AddObject(SrcList.Items[I], 
  67.       SrcList.Items.Objects[I]);
  68.   SrcList.Items.Clear;
  69.   SetItem(SrcList, 0);
  70. end;
  71.  
  72. procedure TDualListDlg.ExcAllBtnClick(Sender: TObject);
  73. var
  74.   I: Integer;
  75. begin
  76.   for I := 0 to DstList.Items.Count - 1 do
  77.     SrcList.Items.AddObject(DstList.Items[I], DstList.Items.Objects[I]);
  78.   DstList.Items.Clear;
  79.   SetItem(DstList, 0);
  80. end;
  81.  
  82. procedure TDualListDlg.MoveSelected(List: TCustomListBox; Items: TStrings);
  83. var
  84.   I: Integer;
  85. begin
  86.   for I := List.Items.Count - 1 downto 0 do
  87.     if List.Selected[I] then
  88.     begin
  89.       Items.AddObject(List.Items[I], List.Items.Objects[I]);
  90.       List.Items.Delete(I);
  91.     end;
  92. end;
  93.  
  94. procedure TDualListDlg.SetButtons;
  95. var
  96.   SrcEmpty, DstEmpty: Boolean;
  97. begin
  98.   SrcEmpty := SrcList.Items.Count = 0;
  99.   DstEmpty := DstList.Items.Count = 0;
  100.   IncludeBtn.Enabled := not SrcEmpty;
  101.   IncAllBtn.Enabled := not SrcEmpty;
  102.   ExcludeBtn.Enabled := not DstEmpty;
  103.   ExAllBtn.Enabled := not DstEmpty;
  104. end;
  105.  
  106. function TDualListDlg.GetFirstSelection(List: TCustomListBox): Integer;
  107. begin
  108.   for Result := 0 to List.Items.Count - 1 do
  109.     if List.Selected[Result] then Exit;
  110.   Result := LB_ERR;
  111. end;
  112.  
  113. procedure TDualListDlg.SetItem(List: TListBox; Index: Integer);
  114. var
  115.   MaxIndex: Integer;
  116. begin
  117.   with List do
  118.   begin
  119.     SetFocus;
  120.     MaxIndex := List.Items.Count - 1;
  121.     if Index = LB_ERR then Index := 0
  122.     else if Index > MaxIndex then Index := MaxIndex;
  123.     Selected[Index] := True;
  124.   end;
  125.   SetButtons;
  126. end;
  127.  
  128. end.
  129.