home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / FDUALLST.PAS < prev    next >
Pascal/Delphi Source File  |  1999-10-12  |  7KB  |  226 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1995 AO ROSNO                   }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit FDualLst;
  10.  
  11. {$I RX.INC}
  12. {$L-,S-}
  13.  
  14. interface
  15.  
  16. uses SysUtils, {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  17.   Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, RXCtrls,
  18.   ExtCtrls, Buttons;
  19.  
  20. type
  21.   TDualListForm = class(TForm)
  22.     SrcList: TTextListBox;
  23.     DstList: TTextListBox;
  24.     SrcLabel: TLabel;
  25.     DstLabel: TLabel;
  26.     IncBtn: TButton;
  27.     IncAllBtn: TButton;
  28.     ExclBtn: TButton;
  29.     ExclAllBtn: TButton;
  30.     OkBtn: TButton;
  31.     CancelBtn: TButton;
  32.     HelpBtn: TButton;
  33.     Bevel1: TBevel;
  34.     procedure IncBtnClick(Sender: TObject);
  35.     procedure IncAllBtnClick(Sender: TObject);
  36.     procedure ExclBtnClick(Sender: TObject);
  37.     procedure ExclAllBtnClick(Sender: TObject);
  38.     procedure SrcListDragOver(Sender, Source: TObject; X, Y: Integer;
  39.       State: TDragState; var Accept: Boolean);
  40.     procedure DstListDragOver(Sender, Source: TObject; X, Y: Integer;
  41.       State: TDragState; var Accept: Boolean);
  42.     procedure SrcListDragDrop(Sender, Source: TObject; X, Y: Integer);
  43.     procedure DstListDragDrop(Sender, Source: TObject; X, Y: Integer);
  44.     procedure SrcListKeyDown(Sender: TObject; var Key: Word;
  45.       Shift: TShiftState);
  46.     procedure DstListKeyDown(Sender: TObject; var Key: Word;
  47.       Shift: TShiftState);
  48.     procedure HelpBtnClick(Sender: TObject);
  49.     procedure FormCreate(Sender: TObject);
  50.     procedure ListClick(Sender: TObject);
  51.   private
  52.     { Private declarations }
  53.     function GetShowHelp: Boolean;
  54.     procedure SetShowHelp(Value: Boolean);
  55.   protected
  56.     procedure CreateParams(var Params: TCreateParams); override;
  57.   public
  58.     { Public declarations }
  59.     procedure SetButtons;
  60.     property ShowHelp: Boolean read GetShowHelp write SetShowHelp
  61.       default True;
  62. end;
  63.  
  64. implementation
  65.  
  66. uses Consts, VCLUtils, BoxProcs;
  67.  
  68. {$R *.DFM}
  69.  
  70. { TDualListForm }
  71.  
  72. procedure TDualListForm.CreateParams(var Params: TCreateParams);
  73. begin
  74.   inherited CreateParams(Params);
  75. end;
  76.  
  77. procedure TDualListForm.SetButtons;
  78. var
  79.   SrcEmpty, DstEmpty: Boolean;
  80. begin
  81.   SrcEmpty := (SrcList.Items.Count = 0);
  82.   DstEmpty := (DstList.Items.Count = 0);
  83.   IncBtn.Enabled := not SrcEmpty and (SrcList.SelCount > 0);
  84.   IncAllBtn.Enabled := not SrcEmpty;
  85.   ExclBtn.Enabled := not DstEmpty and (DstList.SelCount > 0);
  86.   ExclAllBtn.Enabled := not DstEmpty;
  87. end;
  88.  
  89. function TDualListForm.GetShowHelp: Boolean;
  90. begin
  91.   Result := (HelpBtn.Enabled) and (HelpBtn.Visible);
  92. end;
  93.  
  94. procedure TDualListForm.SetShowHelp(Value: Boolean);
  95. const
  96.   x_FrmBtn = 16;
  97.   x_GrpBtn = 15;
  98.   x_BtnBtn = 8;
  99. begin
  100.   with HelpBtn do begin
  101.     Enabled := Value;
  102.     Visible := Value;
  103.   end;
  104.   if Value then begin
  105.     HelpBtn.Left := Width - HelpBtn.Width - x_FrmBtn;
  106.     CancelBtn.Left := HelpBtn.Left - CancelBtn.Width - x_GrpBtn;
  107.     OkBtn.Left := CancelBtn.Left - OkBtn.Width - x_BtnBtn;;
  108.   end
  109.   else begin
  110.     CancelBtn.Left := Width - CancelBtn.Width - x_FrmBtn;
  111.     OkBtn.Left := CancelBtn.Left - OkBtn.Width - x_BtnBtn;;
  112.   end;
  113. end;
  114.  
  115. procedure TDualListForm.IncBtnClick(Sender: TObject);
  116. begin
  117.   BoxMoveSelectedItems(SrcList, DstList);
  118.   SetButtons;
  119. end;
  120.  
  121. procedure TDualListForm.IncAllBtnClick(Sender: TObject);
  122. begin
  123.   BoxMoveAllItems(SrcList, DstList);
  124.   SetButtons;
  125. end;
  126.  
  127. procedure TDualListForm.ExclBtnClick(Sender: TObject);
  128. begin
  129.   BoxMoveSelectedItems(DstList, SrcList);
  130.   SetButtons;
  131. end;
  132.  
  133. procedure TDualListForm.ExclAllBtnClick(Sender: TObject);
  134. begin
  135.   BoxMoveAllItems(DstList, SrcList);
  136.   SetButtons;
  137. end;
  138.  
  139. procedure TDualListForm.SrcListDragOver(Sender, Source: TObject; X,
  140.   Y: Integer; State: TDragState; var Accept: Boolean);
  141. begin
  142.   BoxDragOver(SrcList, Source, X, Y, State, Accept, SrcList.Sorted);
  143.   if State = dsDragLeave then
  144.     (Source as TTextListBox).DragCursor := crDrag;
  145.   if (State = dsDragEnter) and ((Source as TTextListBox).SelCount > 1) then
  146.     (Source as TTextListBox).DragCursor := crMultiDrag;
  147. end;
  148.  
  149. procedure TDualListForm.DstListDragOver(Sender, Source: TObject; X,
  150.   Y: Integer; State: TDragState; var Accept: Boolean);
  151. begin
  152.   BoxDragOver(DstList, Source, X, Y, State, Accept, DstList.Sorted);
  153.   if State = dsDragLeave then
  154.     (Source as TTextListBox).DragCursor := crDrag;
  155.   if (State = dsDragEnter) and ((Source as TTextListBox).SelCount > 1) then
  156.     (Source as TTextListBox).DragCursor := crMultiDrag;
  157. end;
  158.  
  159. procedure TDualListForm.SrcListDragDrop(Sender, Source: TObject; X,
  160.   Y: Integer);
  161. begin
  162.   if Source = DstList then ExclBtnClick(SrcList)
  163.   else if Source = SrcList then begin
  164.     BoxMoveFocusedItem(SrcList, SrcList.ItemAtPos(Point(X, Y), True));
  165.   end;
  166. end;
  167.  
  168. procedure TDualListForm.DstListDragDrop(Sender, Source: TObject; X,
  169.   Y: Integer);
  170. begin
  171.   if Source = SrcList then IncBtnClick(DstList)
  172.   else if Source = DstList then begin
  173.     BoxMoveFocusedItem(DstList, DstList.ItemAtPos(Point(X, Y), True));
  174.   end;
  175. end;
  176.  
  177. procedure TDualListForm.SrcListKeyDown(Sender: TObject; var Key: Word;
  178.   Shift: TShiftState);
  179. var
  180.   Incr: Integer;
  181. begin
  182.   if not SrcList.Sorted then begin
  183.     if (ssCtrl in Shift) and ((Key = VK_DOWN) or (Key = VK_UP)) then begin
  184.       if Key = VK_DOWN then Incr := 1
  185.       else Incr := -1;
  186.       BoxMoveFocusedItem(SrcList, SrcList.ItemIndex + Incr);
  187.       Key := 0;
  188.     end;
  189.   end;
  190. end;
  191.  
  192. procedure TDualListForm.DstListKeyDown(Sender: TObject; var Key: Word;
  193.   Shift: TShiftState);
  194. var
  195.   Incr: Integer;
  196. begin
  197.   if not DstList.Sorted then begin
  198.     if (ssCtrl in Shift) and ((Key = VK_DOWN) or (Key = VK_UP)) then begin
  199.       if Key = VK_DOWN then Incr := 1
  200.       else Incr := -1;
  201.       BoxMoveFocusedItem(DstList, DstList.ItemIndex + Incr);
  202.       Key := 0;
  203.     end;
  204.   end;
  205. end;
  206.  
  207. procedure TDualListForm.HelpBtnClick(Sender: TObject);
  208. begin
  209.   Application.HelpContext(HelpContext);
  210. end;
  211.  
  212. procedure TDualListForm.FormCreate(Sender: TObject);
  213. begin
  214.   OkBtn.Caption := ResStr(SOKButton);
  215.   CancelBtn.Caption := ResStr(SCancelButton);
  216.   HelpBtn.Caption := ResStr(SHelpButton);
  217.   if NewStyleControls then Font.Style := [];
  218. end;
  219.  
  220. procedure TDualListForm.ListClick(Sender: TObject);
  221. begin
  222.   SetButtons;
  223. end;
  224.  
  225. end.
  226.