unit DualListFrame;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons;

type
  TfrDualList = class(TFrame)
    SrcList: TListBox;
    DstList: TListBox;
    IncludeBtn: TSpeedButton;
    IncAllBtn: TSpeedButton;
    ExcludeBtn: TSpeedButton;
    ExAllBtn: TSpeedButton;
    SrcLabel: TLabel;
    DstLabel: TLabel;
    procedure IncludeBtnClick(Sender: TObject);
    procedure IncAllBtnClick(Sender: TObject);
    procedure ExcludeBtnClick(Sender: TObject);
    procedure ExAllBtnClick(Sender: TObject);
    procedure ListDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure ListDragDrop(Sender, Source: TObject; X, Y: Integer);
  private
    FModified: boolean;
    { Private declarations }
    procedure MoveSelected(List: TCustomListBox; Items: TStrings);
    procedure SetItem(List: TListBox; Index: Integer);
    function GetFirstSelection(List: TCustomListBox): Integer;
    procedure MoveItems(SList,DList : TListBox);
    procedure MoveAllItems(SList,DList : TListBox);
    procedure BoxMoveSel(List : TListBox; DstIndex : integer);
  public
    { Public declarations }
    procedure SetButtons;
    property Modified : boolean read FModified write FModified;
  end;

implementation

{$R *.DFM}

procedure TfrDualList.IncludeBtnClick(Sender: TObject);
  begin
    MoveItems(SrcList, DstList);
  end;

procedure TfrDualList.IncAllBtnClick(Sender: TObject);
  begin
    MoveAllItems(SrcList, DstList);
  end;

procedure TfrDualList.ExcludeBtnClick(Sender: TObject);
  begin
    MoveItems(DstList, SrcList);
  end;

procedure TfrDualList.ExAllBtnClick(Sender: TObject);
  begin
    MoveAllItems(DstList, SrcList);
  end;

procedure TfrDualList.MoveSelected(List: TCustomListBox; Items: TStrings);
  var I : integer;
  begin
    for I := 0 to List.Items.Count-1 do if List.Selected[I] then
       Items.AddObject(List.Items[I], List.Items.Objects[I]);
    for I := List.Items.Count - 1 downto 0 do
      if List.Selected[I] then List.Items.Delete(I);
  end;

procedure TfrDualList.SetButtons;
  var SrcEmpty,DstEmpty : boolean;
  begin
    SrcEmpty := SrcList.Items.Count = 0;
    DstEmpty := DstList.Items.Count = 0;
    IncludeBtn.Enabled := not SrcEmpty;
    IncAllBtn.Enabled := not SrcEmpty;
    ExcludeBtn.Enabled := not DstEmpty;
    ExAllBtn.Enabled := not DstEmpty;
  end;

function TfrDualList.GetFirstSelection(List: TCustomListBox): Integer;
  begin
    for Result := 0 to List.Items.Count - 1 do
      if List.Selected[Result] then exit;
    Result := LB_ERR;
  end;

procedure TfrDualList.SetItem(List: TListBox; Index: Integer);
  var MaxIndex : integer;
  begin
    with List do
      begin
        SetFocus;
        MaxIndex := Items.Count - 1;
        if Index = LB_ERR then Index := 0
        else if Index > MaxIndex then Index := MaxIndex;
        Selected[Index] := true;
      end;
    SetButtons; fModified := true;
  end;

procedure TfrDualList.ListDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
  var DragIndex : integer;
  begin
    if Source <> Sender then Accept := true
    else with (Sender as TListBox) do begin
      Accept := False;
      if not Sorted and ((SelCount = 1) or (not MultiSelect)) then begin
        DragIndex := ItemAtPos(Point(X, Y), True);
        if (DragIndex >= 0) and (DragIndex <> ItemIndex) then
          Accept := True;
      end;
    end;
    if State = dsDragLeave then
      (Source as TListBox).DragCursor := crDrag;
    if (State = dsDragEnter) and ((Source as TListBox).SelCount > 1) then
      (Source as TListBox).DragCursor := crMultiDrag;
  end;

procedure TfrDualList.BoxMoveSel(List : TListBox; DstIndex : integer);
  begin
    with List do if (DstIndex >= 0) and (DstIndex < Items.Count) then
      if (DstIndex <> ItemIndex) then begin
        Items.Move(ItemIndex, DstIndex);
        ItemIndex := DstIndex;
        SetItem(List, DstIndex);
      end;
  end;

procedure TfrDualList.ListDragDrop(Sender, Source: TObject; X,
  Y: Integer);
  begin
    if Source <> Sender then
      MoveItems(TListBox(Source), TListBox(Sender))
    else BoxMoveSel(TListBox(Sender),
      TListBox(Sender).ItemAtPos(Point(X, Y), True));
  end;

procedure TfrDualList.MoveItems(SList, DList: TListBox);
  var Index : integer;
  begin
    Index := GetFirstSelection(SList);
    MoveSelected(SList, DList.Items);
    SetItem(SList, Index);
  end;

procedure TfrDualList.MoveAllItems(SList, DList: TListBox);
  var I : integer;
  begin
    with SList.Items do for I := 0 to Count - 1 do
      DList.Items.AddObject(Strings[I], Objects[I]);
    SList.Items.Clear;
    SetItem(SList, 0);
  end;

end.