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

鼠标拖放插入点提示

　　鼠标拖放是Windows常见的操作，比如拷贝文件就可用拖放方式进行。在我们编写的应用程序中，有时为了方便用户操作需要支持鼠标拖放。对于大部分的VCL控件只要鼠标将DragMode设为dmAutomatic，就可以在OnDragDrop、OnDragOver和OnEndDrag中处理拖放事件。与Drag类似的还有一个Dock方式用于支持控件悬浮，控件在悬浮时会显示一个虚线框来表示悬浮位置，而Drag方式却没有这功能。现在让我们尝试在Listbox中显示拖放插入点。
　　上面提及的三个事件中OnDragOver是用来拖放鼠标经过控件上面时产生的，要显示插入点提示当然是在这里进行处理了。事件中先用Listbox.ItemAtPos(Point(X, Y) , true)取鼠标所有在的打目Index，再用Listbox.ItemRect(Index)取得作图区域，最后在区域中画出提示线框。下面给出代码：

Unit1.pas内容

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);
  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.

Unit1.dfm内容［内容较长，请点击此处找开/折叠］

object Form1: TForm1
Left = 192
Top = 107
Width = 540
Height = 376
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object ListBox1: TListBox
    Left = 24
    Top = 24
    Width = 201
    Height = 265
    Style = lbOwnerDrawFixed
    DragMode = dmAutomatic
    ItemHeight = 20
    Items.Strings = (

        ' Accept := (Source is TkktLabelListBox) and (TkktLabelListBox(S' +
        'ource).ItemIndex>-1);')
    TabOrder = 0
    OnDragDrop = ListBox1DragDrop
    OnDragOver = ListBox1DragOver
end
object ListBox2: TListBox
    Left = 264
    Top = 24
    Width = 233
    Height = 265
    Style = lbOwnerDrawFixed
    DragMode = dmAutomatic
    ItemHeight = 20
    Items.Strings = (
      '上代码的确可用而且被广泛使用，但它有一个很大的缺点：'
      '效率大低。因为每次在Listbox中追加、插入或删除一个'
      '条目时，都要调用此函数重新计算横向滚动条宽度'
      '，而遍历所有项目和调用TextWidth都是很是很'
      '耗时的操作。如果用户将条目从当前Listbox拖往另一'
      '个Listbox，那么用户一个操作将有两'
      '个Listbox必须重新计算横向滚动条宽度，当Listbox'
      '内容有上百条的时候，你将明显感觉反应迟缓。'
      '　　OK，现在换个思路。'
      '　　当追加或插入新条目时，只要判断新内容的Text'
      'Width是否大于滚动条宽度，如果是调整滚动条宽度'
      '即可。那么删除呢？是的，遍历是不可避免的，但并不'
      '是每次删除都需要。可以定义一个变量记录Listbox中'
      'TextWidth值最大的条目Index，只有删除这个条目时'
      '才需要遍历，其它时候完全可以不管它。'
      '　　还有一种情况必须考虑，用户可能会改变'
      '屏幕字体，这时也必须重新计算横向滚动条宽度。'
      '跟删除操作一样计算原最大条目的新TextWidth值即可。'
      '　　如果窗体上有多个Listbox，记录每个Listbox的'
      '最大条目也是一件很麻烦的事，所以我把它封装起来，'
      '下面给出完整代码：')
    TabOrder = 1
    OnDragDrop = ListBox1DragDrop
    OnDragOver = ListBox1DragOver
end
end

(完)

http://blog.csdn.net/nhconch/article/details/228018

秒客网

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

相关文章