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.