发掘ListBox的潜力（二）：鼠标拖放插入点提示

鼠标拖放插入点提示

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);
private
FDragOverObject: TObject; //ListBox1DragDrop、ListBox1DragOver由多个Listbox共享，这里记录当前那个Listbox接受鼠标拖放
FDragOverItemIndex: Integer; //记录鼠标所在条目的Index
procedure DrawInsertLine;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{========================================================================
DESIGN BY : 彭国辉
DATE: 2004-12-24
SITE: http://kacarton.yeah.net/
BLOG: http://blog.csdn.net/nhconch
EMAIL: kacarton#sohu.com

文章为作者原创，转载前请先与本人联系，转载请注明文章出处、保留作者信息，谢谢支持！
=========================================================================}

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
i: integer;
begin
//拖放完成，将内容从原来的Listbox读到目标Listbox
with TListBox(Source) do begin
i := TListBox(Sender).ItemAtPos(Point(X, Y) , true);
if i<>-1 then
TListBox(Sender).Items.InsertObject(i, Items[ItemIndex], Items.Objects[ItemIndex])
else
i := TListBox(Sender).Items.AddObject(Items[ItemIndex], Items.Objects[ItemIndex]);
if (Sender=Source) and (i>ItemIndex) then i := i-1;
DeleteSelected;
if (Sender=Source) then ItemIndex := i;
end;
FDragOverObject := nil;
FDragOverItemIndex := -1;
end;

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
var
Index: Integer;
begin
Accept := (Source is TListBox) and (TListBox(Source).ItemIndex>-1); //只接受来自Listbox的内容
if not Accept then Exit;
if (FDragOverObject<>nil) and (Sender<>FDragOverObject) then
DrawInsertLine; //鼠标离开Listbox时，擦除插入位置提示线框
Index := TListBox(Sender).ItemAtPos(Point(X, Y) , true);
if (FDragOverObject = Sender) and (FDragOverItemIndex = Index) then Exit; //当鼠标在同一条目上移动时，只画一次即可
if (FDragOverObject = Sender) and (FDragOverItemIndex <> Index) then
DrawInsertLine; //鼠标移到新位置，擦除旧的插入位置提示线框
FDragOverObject := Sender;
FDragOverItemIndex := Index;
DrawInsertLine; //画出插入位置提示线框
end;

procedure TForm1.DrawInsertLine;
var
R: TRect;

文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!