发掘ListBox的潜力(二):鼠标拖放插入点提示
2008-04-09 04:22:13来源:互联网 阅读 ()
鼠标拖放插入点提示
鼠标拖放是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;
标签:
版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有
下一篇:delphi2005中文翻译
IDC资讯: 主机资讯 注册资讯 托管资讯 vps资讯 网站建设
网站运营: 建站经验 策划盈利 搜索优化 网站推广 免费资源
网络编程: Asp.Net编程 Asp编程 Php编程 Xml编程 Access Mssql Mysql 其它
服务器技术: Web服务器 Ftp服务器 Mail服务器 Dns服务器 安全防护
软件技巧: 其它软件 Word Excel Powerpoint Ghost Vista QQ空间 QQ FlashGet 迅雷
网页制作: FrontPages Dreamweaver Javascript css photoshop fireworks Flash