发掘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 (iItemIndex) 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 (FDragOverObjectnil) and (SenderFDragOverObject) 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.Count0 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.