listbox多选状态下的自拖与互拖

unit Unit1;

 

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

ListBox1: TListBox;

ListBox2: TListBox;

procedure ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);

procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

var

aPoint: TPoint;

begin

aPoint.x := x;

aPoint.y := y;

if (source is Tlistbox) then

if ((source as Tlistbox).SelCount > 0) and

((sender as Tlistbox).ItemAtPos(apoint, true) <> -1)

and ((sender as Tlistbox).itematpos(apoint, true) <> (sender as Tlistbox).itemindex) then

begin

accept := true;

end;

end;

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);

var

aPoint: TPoint;

st: string;

p: integer;

i, num: integer;

MYlBox: TStrings;

begin

aPoint.x := x;

aPoint.y := y;

p := (sender as Tlistbox).itematpos(aPoint, true);

MYlBox := Tstringlist.Create;

try

Num := (source as Tlistbox).Items.Count;

for i := num - 1 downto 0 do

begin

if (source as Tlistbox).Selected[i] then

begin

st := (source as Tlistbox).Items[i];

MYlBox.Add(st)

end;

end;

if p > -1 then

begin

for i := 0 to Mylbox.Count - 1 do

begin

(sender as Tlistbox).Items.Insert(p, mylbox[i])

end;

end

else

begin

for i := Mylbox.Count - 1 downto 0 do

begin

(sender as Tlistbox).Items.Add(mylbox[i])

end;

end;

(source as Tlistbox).DeleteSelected;

if P > -1 then

(sender as Tlistbox).Selected[p] := true;

finally

mylbox.Free;

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

listbox2.OnDragDrop := listbox1.OnDragDrop;

listbox2.OnDragOver := listbox1.OnDragOver;

listbox1.MultiSelect := true;

listbox2.MultiSelect := true;

listbox1.DragMode := dmAutomatic;

listbox2.DragMode := dmAutomatic;

end;

end.