home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SOURCE.DAT / SOURCE / ADDON / DUALLIST.PAS < prev    next >
Pascal/Delphi Source File  |  1997-07-01  |  9KB  |  362 lines
  1. Unit DualList;
  2.  
  3. Interface
  4.  
  5. Uses
  6.   SysUtils,Classes,Forms,Buttons,StdCtrls;
  7.  
  8. Type
  9.   TDualList=Class(TControl)
  10.     Private
  11.        FSrcLabel:TLabel;
  12.        FDstLabel:TLabel;
  13.        FSrcList:TListBox;
  14.        FDstList:TListBox;
  15.        FAddBtn:TSpeedButton;
  16.        FAddAllBtn:TSpeedButton;
  17.        FDelBtn:TSpeedButton;
  18.        FDelAllBtn:TSpeedButton;
  19.        FOnChange:TNotifyEvent;
  20.        Function GetSrcName:String;
  21.        Procedure SetSrcName(Value:String);
  22.        Function GetSrcItems:TStrings;
  23.        Procedure SetSrcItems(Value:TStrings);
  24.        Function GetDstName:String;
  25.        Procedure SetDstName(Value:String);
  26.        Function GetDstItems:TStrings;
  27.        Procedure SetDstItems(Value:TStrings);
  28.        Procedure UpdateButtons;
  29.        Procedure EvItemSelect(Sender:TObject;Index:LongInt);
  30.        Procedure EvAdd(Sender:TObject);
  31.        Procedure EvAddAll(Sender:TObject);
  32.        Procedure EvDel(Sender:TObject);
  33.        Procedure EvDelAll(Sender:TObject);
  34.     Protected
  35.        Procedure SetupComponent;Override;
  36.        Procedure SetupShow;Override;
  37.        Procedure Resize;Override;
  38.        Procedure SetFocus;Override;
  39.        Procedure FontChange;Override;
  40.        Property Hint;
  41.     Public
  42.        Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  43.        Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
  44.        Property SrcListBox:TListBox Read FSrcList;
  45.        Property DstListBox:TListBox Read FDstList;
  46.        Property XAlign;
  47.        Property XStretch;
  48.        Property YAlign;
  49.        Property YStretch;
  50.     Published
  51.        Property Align;
  52.        Property PenColor;
  53.        Property DstItems:TStrings Read GetDstItems Write SetDstItems;
  54.        Property DstName:String Read GetDstName Write SetDstName;
  55.        Property Enabled;
  56.        Property Font;
  57.        Property ParentPenColor;
  58.        Property ParentFont;
  59.        Property SrcItems:TStrings Read GetSrcItems Write SetSrcItems;
  60.        Property SrcName:String Read GetSrcName Write SetSrcName;
  61.        Property TabOrder;
  62.        Property Visible;
  63.        Property ZOrder;
  64.  
  65.        Property OnChange:TNotifyEvent Read FOnChange Write FOnChange;
  66.        Property OnFontChange;
  67.        Property OnSetupShow;
  68.   End;
  69.  
  70.  
  71. Function InsertDualList(parent:TControl;Left,Bottom,Width,Height:LongInt;
  72.   Const SrcName,DstName:String):TDualList;
  73.  
  74.  
  75. Implementation
  76.  
  77.  
  78. Function InsertDualList(parent:TControl;Left,Bottom,Width,Height:LongInt;
  79.   Const SrcName,DstName:String):TDualList;
  80. Begin
  81.   Result.Create(parent);
  82.   Result.SetWindowPos(Left,Bottom,Width,Height);
  83.   Result.SrcName := SrcName;
  84.   Result.DstName := DstName;
  85.   Result.parent := parent;
  86. End;
  87.  
  88.  
  89. Procedure TDualList.SetupComponent;
  90. Begin
  91.   Inherited SetupComponent;
  92.  
  93.   Name := 'DualList';
  94.   Width := 340;
  95.   Height := 200;
  96.   ParentPenColor := True;
  97.   ParentColor := True;
  98.   TabStop := False;
  99.  
  100.   FSrcLabel := InsertLabel(Self,0,175,140,25,LoadNLSStr(SSource));
  101.   If Designed Then Include(FSrcLabel.ComponentState, csDetail);
  102.   FDstLabel := InsertLabel(Self,200,175,140,25,LoadNLSStr(SDestination));
  103.   If Designed Then Include(FDstLabel.ComponentState, csDetail);
  104.  
  105.   FSrcList := InsertListBox(Self,0,0,140,175,'');
  106.   FSrcList.MultiSelect := True;
  107.   FSrcList.ExtendedSelect := True;
  108.   FSrcList.OnItemFocus := EvItemSelect;
  109.   FSrcList.OnItemSelect := EvItemSelect;
  110.   If Designed Then Include(FSrcList.ComponentState, csDetail);
  111.   FDstList := InsertListBox(Self,200,0,140,175,'');
  112.   FDstList.MultiSelect := True;
  113.   FDstList.ExtendedSelect := True;
  114.   FDstList.OnItemFocus := EvItemSelect;
  115.   FDstList.OnItemSelect := EvItemSelect;
  116.   If Designed Then Include(FDstList.ComponentState, csDetail);
  117.  
  118.   FAddBtn := InsertSpeedButton(Self,155,145,30,30,0,'>','');
  119.   FAddBtn.OnClick := EvAdd;
  120.   If Designed Then Include(FAddBtn.ComponentState, csDetail);
  121.   FAddAllBtn := InsertSpeedButton(Self,110,40,30,30,0,'>>','');
  122.   FAddAllBtn.OnClick := EvAddAll;
  123.   If Designed Then Include(FAddAllBtn.ComponentState, csDetail);
  124.   FDelBtn := InsertSpeedButton(Self,155,75,30,30,0,'<','');
  125.   FDelBtn.OnClick := EvDel;
  126.   If Designed Then Include(FDelBtn.ComponentState, csDetail);
  127.   FDelAllBtn := InsertSpeedButton(Self,155,40,30,30,0,'<<','');
  128.   FDelAllBtn.OnClick := EvDelAll;
  129.   If Designed Then Include(FDelAllBtn.ComponentState, csDetail);
  130. End;
  131.  
  132.  
  133. Procedure TDualList.SetupShow;
  134. Begin
  135.   Inherited SetupShow;
  136.  
  137.   Resize;
  138.   UpdateButtons;
  139. End;
  140.  
  141.  
  142. Procedure TDualList.Resize;
  143. Var
  144.   LBWidth:LongInt;
  145. Begin
  146.   Inherited Resize;
  147.  
  148.   LBWidth := (Width - 60) Div 2;
  149.   FSrcLabel.SetWindowPos(0,Height-25,LBWidth,25);
  150.   FDstLabel.SetWindowPos(Width-LBWidth,Height-25,LBWidth,25);
  151.  
  152.   FSrcList.SetWindowPos(0,0,LBWidth,Height-25);
  153.   FDstList.SetWindowPos(Width-LBWidth,0,LBWidth,Height-25);
  154.  
  155.   FAddBtn.SetWindowPos(LBWidth+15,Height-55,30,30);
  156.   FAddAllBtn.SetWindowPos(LBWidth+15,Height-90,30,30);
  157.   FDelBtn.SetWindowPos(LBWidth+15,Height-125,30,30);
  158.   FDelAllBtn.SetWindowPos(LBWidth+15,Height-160,30,30);
  159. End;
  160.  
  161.  
  162. Procedure TDualList.SetFocus;
  163. Begin
  164.   Inherited SetFocus;
  165.  
  166.   FSrcList.CaptureFocus;
  167. End;
  168.  
  169.  
  170. Procedure TDualList.FontChange;
  171. Var
  172.   I:LongInt;
  173. Begin
  174.   Inherited FontChange;
  175.  
  176.   For I := 0 To ControlCount-1 Do Controls[I].Font := Font;
  177. End;
  178.  
  179.  
  180. Function TDualList.GetSrcName:String;
  181. Begin
  182.   Result := FSrcLabel.Caption;
  183. End;
  184.  
  185.  
  186. Procedure TDualList.SetSrcName(Value:String);
  187. Begin
  188.   FSrcLabel.Caption := Value;
  189. End;
  190.  
  191.  
  192. Function TDualList.GetSrcItems:TStrings;
  193. Begin
  194.   Result := FSrcList.Items;
  195. End;
  196.  
  197.  
  198. Procedure TDualList.SetSrcItems(Value:TStrings);
  199. Begin
  200.   FSrcList.Items := Value;
  201. End;
  202.  
  203.  
  204. Function TDualList.GetDstName:String;
  205. Begin
  206.   Result := FDstLabel.Caption;
  207. End;
  208.  
  209.  
  210. Procedure TDualList.SetDstName(Value:String);
  211. Begin
  212.   FDstLabel.Caption := Value;
  213. End;
  214.  
  215.  
  216. Function TDualList.GetDstItems:TStrings;
  217. Begin
  218.   Result := FDstList.Items;
  219. End;
  220.  
  221.  
  222. Procedure TDualList.SetDstItems(Value:TStrings);
  223. Begin
  224.   FDstList.Items := Value;
  225. End;
  226.  
  227.  
  228. Procedure TDualList.UpdateButtons;
  229. Begin
  230.   If Designed Then Exit;
  231.   FAddBtn.Enabled := FSrcList.ItemIndex >= 0;
  232.   FAddAllBtn.Enabled := FSrcList.Items.Count > 0;
  233.   FDelBtn.Enabled := FDstList.ItemIndex >= 0;
  234.   FDelAllBtn.Enabled := FDstList.Items.Count > 0;
  235. End;
  236.  
  237.  
  238. {$HINTS OFF}
  239. Procedure TDualList.EvItemSelect(Sender:TObject;Index:LongInt);
  240. Begin
  241.   UpdateButtons;
  242. End;
  243.  
  244.  
  245. Procedure TDualList.EvAdd(Sender:TObject);
  246. Var
  247.   DstCount,I:LongInt;
  248. Begin
  249.   DstCount := FDstList.Items.Count;
  250.   For I := FSrcList.Items.Count-1 DownTo 0 Do
  251.   Begin
  252.     If FSrcList.Selected[I] Then
  253.     Begin
  254.       FDstList.Items.Insert(DstCount, FSrcList.Items[I]);
  255.       FSrcList.Items.Delete(I);
  256.     End;
  257.   End;
  258.   UpdateButtons;
  259.   If FOnChange <> Nil Then FOnChange(Self);
  260. End;
  261.  
  262.  
  263. Procedure TDualList.EvAddAll(Sender:TObject);
  264. Var
  265.   DstCount,I:LongInt;
  266. Begin
  267.   DstCount := FDstList.Items.Count;
  268.   For I := FSrcList.Items.Count-1 DownTo 0 Do
  269.   Begin
  270.     FDstList.Items.Insert(DstCount, FSrcList.Items[I]);
  271.   End;
  272.   FSrcList.Items.Clear;
  273.   UpdateButtons;
  274.   If FOnChange <> Nil Then FOnChange(Self);
  275. End;
  276.  
  277.  
  278. Procedure TDualList.EvDel(Sender:TObject);
  279. Var
  280.   SrcCount,I:LongInt;
  281. Begin
  282.   SrcCount := FSrcList.Items.Count;
  283.   For I := FDstList.Items.Count-1 DownTo 0 Do
  284.   Begin
  285.     If FDstList.Selected[I] Then
  286.     Begin
  287.       FSrcList.Items.Insert(SrcCount, FDstList.Items[I]);
  288.       FDstList.Items.Delete(I);
  289.     End;
  290.   End;
  291.   UpdateButtons;
  292.   If FOnChange <> Nil Then FOnChange(Self);
  293. End;
  294.  
  295.  
  296. Procedure TDualList.EvDelAll(Sender:TObject);
  297. Var
  298.   SrcCount,I:LongInt;
  299. Begin
  300.   SrcCount := FSrcList.Items.Count;
  301.   For I := FDstList.Items.Count-1 DownTo 0 Do
  302.   Begin
  303.     FSrcList.Items.Insert(SrcCount, FDstList.Items[I]);
  304.   End;
  305.   FDstList.Items.Clear;
  306.   UpdateButtons;
  307.   If FOnChange <> Nil Then FOnChange(Self);
  308. End;
  309. {$HINTS ON}
  310.  
  311.  
  312. Function TDualList.WriteSCUResource(Stream:TResourceStream):Boolean;
  313. Var
  314.   aText:PChar;
  315. Begin
  316.   Result := Inherited WriteSCUResource(Stream);
  317.   If Not Result Then Exit;
  318.  
  319.   aText := SrcItems.GetText;
  320.   If aText <> Nil Then
  321.   Begin
  322.     Result := Stream.NewResourceEntry('rnSrcItems',aText^,Length(aText^)+1);
  323.     StrDispose(aText);
  324.   End;
  325.   If Not Result Then Exit;
  326.  
  327.   aText := DstItems.GetText;
  328.   If aText <> Nil Then
  329.   Begin
  330.     Result := Stream.NewResourceEntry('rnDstItems',aText^,Length(aText^)+1);
  331.     StrDispose(aText);
  332.   End;
  333. End;
  334.  
  335.  
  336. Procedure TDualList.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
  337. Var
  338.   aText:PChar;
  339. Begin
  340.   If ResName = 'rnSrcItems' Then
  341.   Begin
  342.     aText := @Data;
  343.     SrcItems.SetText(aText);
  344.   End
  345.   Else
  346.   If ResName = 'rnDstItems' Then
  347.   Begin
  348.     aText := @Data;
  349.     DstItems.SetText(aText);
  350.   End
  351.   Else Inherited ReadSCUResource(ResName,Data,DataLen)
  352. End;
  353.  
  354.  
  355.  
  356.  
  357. Begin
  358.   RegisterClasses([TDualList]);
  359. End.
  360.  
  361.  
  362.