发掘ListBox的潜力(二):鼠标拖放插入点提示
2016-04-15 00:33
393 查看
鼠标拖放插入点提示
鼠标拖放是Windows常见的操作,比如拷贝文件就可用拖放方式进行。在我们编写的应用程序中,有时为了方便用户操作需要支持鼠标拖放。对于大部分的VCL控件只要鼠标将DragMode设为dmAutomatic,就可以在OnDragDrop、OnDragOver和OnEndDrag中处理拖放事件。与Drag类似的还有一个Dock方式用于支持控件悬浮,控件在悬浮时会显示一个虚线框来表示悬浮位置,而Drag方式却没有这功能。现在让我们尝试在Listbox中显示拖放插入点。
上面提及的三个事件中OnDragOver是用来拖放鼠标经过控件上面时产生的,要显示插入点提示当然是在这里进行处理了。事件中先用Listbox.ItemAtPos(Point(X, Y) , true)取鼠标所有在的打目Index,再用Listbox.ItemRect(Index)取得作图区域,最后在区域中画出提示线框。下面给出代码:
(完)
http://blog.csdn.net/nhconch/article/details/228018
鼠标拖放是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
相关文章推荐
- 自定义View(一),初识自定义View
- 发掘ListBox的潜力(一):自动调整横向滚动条宽度
- 求数组中最大的值
- 软件设计模式——你真的会写单例模式吗?
- jdbcTemplate实现分页功能
- 深度测试
- 差分约束系统
- 简单的leetcode题(四)
- GPU 加速NLP任务(Theano+CUDA)
- 3.1.4 Memcached的简单使用过程
- JS中的内部类
- 欢迎使用CSDN-markdown编辑器
- poj 1741 树的分治。。。。
- iOS开发总结之仿qq侧滑功能
- 读书笔记 数据化营销
- Linux下配置用msmtp和mutt发邮件
- GUI之绘制2D贴图
- 3.1.3 Memcached的安装(2)
- 链接之外部链接与内部链接
- 自绘ListBox的两种效果