发掘ListBox的潜力(二):鼠标拖放插入点提示

涿州懒洋洋

涿州懒洋洋

2016-02-19 18:24

下面是个简单易学的发掘ListBox的潜力(二):鼠标拖放插入点提示教程,图老师小编详细图解介绍包你轻松学会,喜欢的朋友赶紧get起来吧!
 

鼠标拖放插入点提示

  鼠标拖放是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;

(本文来源于图老师网站,更多请访问http://m.tulaoshi.com/bianchengyuyan/)

  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;

(本文来源于图老师网站,更多请访问http://m.tulaoshi.com/bianchengyuyan/)

  end.
  

展开更多 50%)
分享

猜你喜欢

发掘ListBox的潜力(二):鼠标拖放插入点提示

编程语言 网络编程
发掘ListBox的潜力(二):鼠标拖放插入点提示

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

编程语言 网络编程
发掘ListBox的潜力(一):自动调整横向滚动条宽度

s8lol主宰符文怎么配

英雄联盟 网络游戏
s8lol主宰符文怎么配

父母要发掘孩子的兴趣点和潜力

电脑网络
父母要发掘孩子的兴趣点和潜力

VB5.0中实现鼠标拖放

编程语言 网络编程
VB5.0中实现鼠标拖放

lol偷钱流符文搭配推荐

英雄联盟 网络游戏
lol偷钱流符文搭配推荐

充分发掘相机潜力 特殊状况下的微单旅行拍摄

摄影 人像摄影 静物摄影
充分发掘相机潜力 特殊状况下的微单旅行拍摄

CorelDRAW绘制的鼠标 第二节:鼠标外形绘制

CorelDRAW
CorelDRAW绘制的鼠标 第二节:鼠标外形绘制

lolAD刺客新符文搭配推荐

英雄联盟
lolAD刺客新符文搭配推荐

看一小会儿COM所做笔记

看一小会儿COM所做笔记

Delphi编程实现Ping操作

Delphi编程实现Ping操作
下拉加载更多内容 ↓