鼠标拖放插入点提示

  鼠标拖放是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的潜力(二):鼠标拖放插入点提示的更多相关文章

  1. 发掘ListBox的潜力(一):自动调整横向滚动条宽度

    <自绘ListBox的两种效果>一文帖出之后,从反馈信息来看,大家对这种小技巧还是很认同.接下来我将继续围绕ListBox写一系列的文章,进一步发掘ListBox的潜力,其中包括:自动调整 ...

  2. 发掘ListBox的潜力(三):显示即时提示(Tips)

    ListBox显示即时提示(Tips) Listbox内容太长时超出Listbox宽度的部分将无法显示,一种解决方法是让Listbox产生横向滚动条,滚动显示内容(见前面的<发掘ListBox的 ...

  3. PyQt(Python+Qt)学习随笔:Qt Designer中部件的是否接受鼠标拖放事件的acceptDrops属性及含义

    acceptDrops属性表示当前部件是否接受鼠标拖放事件,鼠标拖放应该是与鼠标拖拽结合在一起的,在Qt Designer中可以通过属性acceptDrops设置部件是否接受鼠标拖放事件.如果部件接受 ...

  4. ASP.NET TextBox 当鼠标点击后清空默认提示文字

    ASP.NET TextBox 当鼠标点击后清空默认提示文字 [ 方法一] 前台代码: <div>    <asp:TextBox ID="txtName" ru ...

  5. Qt应用程序主窗口之二:拖放操作与打印文档

    一.拖放操作 对于一个实用的应用程序,不仅希望能从文件菜单中打开一个文件,更希望可以通过拖动直接将桌面上的文件拖入程序界面上来打开,就像可以将.pro文件拖入Creator中来打开整个项目一样.Qt中 ...

  6. 鼠标拖放div 实现

    Javascript的mousemove事件类型是一个实时响应的事件,当鼠标指针的位置发生变化时(至少移动1个像素),就会触发mousemove事件.该事件响应的灵敏度主要参考鼠标指针移动速度的快慢, ...

  7. 【算法】【python实现】二叉搜索树插入、删除、查找

    二叉搜索树 定义:如果一颗二叉树的每个节点对应一个关键码值,且关键码值的组织是有顺序的,例如左子节点值小于父节点值,父节点值小于右子节点值,则这棵二叉树是一棵二叉搜索树. 类(TreeNode):定义 ...

  8. 轻快的vim(二):插入

    上一节我们讲到了VIM中的移动,既然已经能够在屏幕和光标间游刃有余了 那么,现在就来谈谈插入命令 不知道有多少VIM新手和我当年(去年)一样,信誓旦旦的以为只有i可以插入 唉,现在想想都觉得可笑,都是 ...

  9. 萌新笔记——C++里创建 Trie字典树(中文词典)(二)(插入、查找、导入、导出)

    萌新做词典第二篇,做得不好,还请指正,谢谢大佬! 做好了插入与遍历功能之后,我发现最基本的查找功能没有实现,同时还希望能够把内存的数据存入文件保存下来,并可以从文件中导入词典.此外,数据的路径是存在配 ...

随机推荐

  1. 打工心态废掉了很多人,包括你吗?(你把现在这家公司的业务都弄清楚、弄懂了吗?君子报仇十年不晚!不离不弃!)good

    我只拿这点钱,凭什么去做那么多工作,我傻呀. 我为公司干活,公司付我一份报酬,等价交换而已,我不欠谁的. 我只要对得起这份薪水就行了,多一点我都不干,做了也白做. 工作嘛,又不是为自己干,说得过去就行 ...

  2. 常见makefile写法

    原文地址:blog.csdn.net/ghostyu/article/details/7755177 1.目标名称,摆脱手动设置目标名称 TARGET = $(notdir $(CURDIR)) al ...

  3. (step7.2.4)hdu 2674(N!Again——简单数论)

    题目大意:输入一个整数n,输出N! mod 2009 的结果. 解题思路: 1)任意数  n = ( n / 2009) * 2009 + n % 2009 2)40!  mod 2009  等于 2 ...

  4. UE-9260使用说明1

    UE-9260使用说明 序号 版本号 日期 备注 1 V0.1 2015-03-21 原始版本号.作者:xiaobin 2 3 4 5 主机环境 1.烧写操作 仿真器和FTP烧写 OS: Win XP ...

  5. CF(437C)The Child and Toy(馋)

    意甲冠军:给定一个无向图,每个小点右键.操作被拉动所有点逐一将去,直到一个点的其余部分,在连边和点拉远了点,在该点右点的其余的费用.寻找所需要的最低成本的运营完全成本. 解法:贪心的思想,每次将剩余点 ...

  6. Eclipse中JBOSS5.1无法启动的问题解决办法

    今天在Eclipse中启动JBoss 5.1时遇到这样的一个错误: …… ERROR [AbstractKernelController] Error installing to Instantiat ...

  7. CentOS下Samba文件服务器的安装与配置

    CentOS下Samba文件服务器的安装与配置 http://blog.csdn.net/limingzhong198/article/details/22064801 一.安装配置 1. 安装sam ...

  8. mysql 创建表 create table详解

      1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 ...

  9. The parent project must have a packaging type of POM

    在Eclipse中使用Maven添加模块时报错:The parent project must have a packaging type of POM 解决办法: 是将pom.xml 中的  < ...

  10. <?php echo "我的第一段 PHP 脚本!"; ?>

    <!DOCTYPE html><html><body> <?phpecho "我的第一段 PHP 脚本!";?> </body ...