今天调整系统的一些技巧部分,用到了拖放,在网上搜集了两种方式,略作修正,备忘一下。
我喜欢第一种方式,拖放时在选择框内显示可拖放状态,第二种限制在可选择的项上显示可拖放状态,但第二种简单一些。
网上还有一种方式,托过的项上全部为选择状态,很不好看,就不再记录了。
我习惯了用Sender,原作用的是Source,没有测试,同一个对象,应该是可以的。
// CheckListBox两种拖放方式,第一种
procedure TForm1.CheckListBox2DragDrop(Sender, Source: TObject; X, Y: Integer);
var
i: Integer;str: string;
begin
TCheckListBox(Sender).DragMode := dmAutomatic;
for i := TCheckListBox(Sender).Items.Count - 1 downto 0 do
begin
if TCheckListBox(Sender).Selected[i] then
begin
with Sender as TCheckListBox do
begin
str := Items[i];
Items.Delete(i);
end;
with Sender as TCheckListBox do
begin
Items.Insert(ItemAtPos(Point(X, Y), false), str);
end;
end;
end;
end;
procedure TForm1.CheckListBox2DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := false;
if Sender is TCheckListBox then
with Sender as TCheckListBox do
if Items.Count > 0 then
Accept := True;
end;
// CheckListBox两种拖放方式,第二种
procedure TForm1.CheckListBox2DragDrop(Sender, Source: TObject; X, Y: Integer);
var
i: Integer;
begin
TCheckListBox(Sender).DragMode := dmAutomatic;
i := TCheckListBox(Sender).ItemAtPos(Point(X, Y), True);
if i < 0 then
exit;
TCheckListBox(Sender).Items.Move(TCheckListBox(Sender).ItemIndex, i);
TCheckListBox(Sender).ItemIndex := i;
end;
procedure TForm1.CheckListBox2DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := (Sender = Source) and (TCheckListBox(Sender).ItemIndex >= 0) and
(TCheckListBox(Sender).ItemAtPos(Point(X, Y), True) >= 0);
end;