发掘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;
begin
  if FDragOverObject = nil then Exit;
  with TListBox(FDragOverObject) do begin
　  if FDragOverItemIndex > -1 then begin
　　  R := ItemRect(FDragOverItemIndex);
　　  R.Bottom := R.Top + 4;
　  end else if Items.Count>0 then begin
　　  R := ItemRect(Items.Count-1);
　　  R.Top := R.Bottom - 4;
　  end else begin
　　  windows.GetClientRect(Handle, R);
　　  R.Bottom := R.Top + 4;
　  end;
　  DrawFocusRect(Canvas.Handle, R);
　  InflateRect(R, -1, -1);
　  DrawFocusRect(Canvas.Handle, R);
  end;
end;

end.