DELPHI中鼠标的各种操作

{鼠标：右击，左击，单击，双击，滚轮，拖曳}
Delphi程序设计中的鼠标控制
2008-06-28 20:15
在Windows环境下，鼠标和键盘是主要的输入设备。

在Delphi中几乎每个对象都具有反映鼠标控制的事件，
这些事件的主要功能包括改变鼠标指针的形状，移动、触发、拖动鼠标等。
鼠标控制的三个相关属性是Cursor、DragCursor、DragMode；
鼠标(拖拽)控制的三个对象方法是BeginDrag、Dragging、EndDrag；
鼠标控制的七个事件包括OnDragDrop等。

一、改变鼠标指针的形状
　　改变鼠标指针的形状在Windows环境下是不可缺少的功能。
当应用程序在执行一个较长时间的指令或动作时，
我们可以改变鼠标指针的形状来通知用户程序执行的状态，
等到执行的动作完成之后，再把鼠标指针的形状变回来。
此外，在拖动的过程中我们也可以改变鼠标指针的形状，使拖动的过程更加清楚。
　　在编辑过程中，我们可以用属性Cursor和DragCursor改变鼠标指针的形状，
前者是记录鼠标指针在对象上出现的情况；后者是设定对象被拖动时鼠标指针的形状。
对于这两个属性，Delphi提供了如下值供用户选择：cdDefault、crArrow、cdCross、crBeam、crSize等十几个属性值。

二、鼠标的移动
　　鼠标移动时会触发事件OnMouseMove，语法如下：
　　procedure ObjectMouseMove(Sender:TObject;Shift:TshiftState;X，Y:Integer)
其中参数Sender代表((目标对象))，参数Shift代表鼠标移动时需同时按下的组合键，
由{ssShift，ssAlt，ssCtrl，ssRight，ssLeft，ssMiddle，ssDouble}组成。
此外，我们也可以利用参数X和Y取得鼠标移动的坐标位置，通常我们使用OnMouseMove事件时，最重要的就是这两个参数。

三、鼠标按键
　　鼠标按键在窗口环境中也是最重要的输入方法之一，
同时还可以配合Shift，Alt，Ctrl三个键而发挥不同的作用。
和鼠标按键有关的事件有OnMouseDown和OnMouseUp。
当用户按下鼠标的一个键后，会触发OnMouseDown事件，其语法如下：
　　procedure ObjectMouseDown(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X，Y:Integer);
　　参数Button指出按下的鼠标键是哪一个，可以是{mbLeft，mbRight，mbMiddle}三者之一。
   参数Shift可以反映按下的键盘键与鼠标的关系，
   其值是由{ssShift，ssAlt，ssCtrl，ssLeft，ssRight，ssMiddle，ssDouble}所组合而成的集合，
   这些参数值分别代表Shift，Alt，Ctrl键、鼠标的左、中、右键，及同时按下左右键。
   例如，同时按下鼠标的右键和Alt键，参数Shift的值就是{ssAlt，ssRight}。

四、鼠标的拖动（细节）
　　（一）启动拖动状态
　　拖动状态的方式及启动是根据属性DragMode值的设定而决定的，可以分成两类情况：
　　1．不必程序控制　如果DragMode的值是dmAutomatic，当鼠标左键一按，对象就自动进入拖动状态。
　　2．需要程序控制　如果DragMode的值是dmManual，要使对象进入拖动状态，可以调用方法BeginDrag。
　　此外，Delphi提供一个对象方法Dragging，让程序判断对象是否进入拖动状态。
如果返回值是TRUE，代表已进入拖动状态，否则就是没有。
要使对象进入拖动状态，可以调用对象方法BeginDrag。
当对象进入拖动状态时，事件OnStartDrag会被触发，有关语法如下：
　　对象方法Dragging语法如下：
　　function Dragging:Boolean;
　　对象方法BeginDrag语法如下：
　　Procedure BeginDrag(Immediate:Boolean);
　　事件OnStartDrag语法如下：
　　Procedure ObjectStartDrag(Sender:TObject;Var DragObject:TDragObject);
　　（二）拖动中的事件
　　关于对象在拖动状态的事件有两个：OnDragDrop和OnDragOver。
假设把对象A拖动并放入对象B中，此时对象B的事件OnDragDrop会被触发。其语法如下：
　　procedure ObjectDragDrop(Sender，Source:TObject;X，Y:Integer);
　　参数Sender和Source分别代表目标对象B及被拖动的对象A，
参数X，Y代表拖动结束时的位置坐标，此坐标是以目标对象的坐标为参考的，
而实际上拖动中的对象并不是真的移动，所以以X，Y的值将对象移到新的位置。
　　(三)停止拖动
　　如果要停止拖动，可以使用对象方法EndDrag来完成；其语法如下：
　　procedure ObjectEndDrag(Drop:Boolean);
　　参数Drop若是Ture，被拖动的对象将被放置于与目前所在的位置；
否则，对象的拖动就被放弃，而回到原来的位置。
例如下面的程序段就代表对象Lable1放弃拖动，并恢复原状：
　　Lable1.EndDrag(False);
　　而停止拖动会触发事件OnEndDrag，其语法如下：
　　Procedure ObjectEndDrag(Sender，Target:TObject;X，Y:Integer);
　　不管是放弃拖动或是对象已经拖动到目标对象，均会触发这个事件。
参数Sender和Target分别指向被拖动对象(源)及目标对象，但是如果拖动没有成功，则Target值为nil。

补充：
DELPHI中拖放的操作

拖放(DragDrop)是Windows提供的一种快捷的操作方式。作为基于Windows的开发工
具，Delphi同样支持拖放操作，而且开发应用系统的拖放功能十分方便，真正体现了
Delphi 的强大功能和方便性。
　Delphi提供的所有控件(Control，即能获得输入焦点的部件)都支持拖放操作，并有
相应的拖放属性、拖放事件和拖放方法。下面我们先介绍控件的拖放支持，而后再给出开
发拖放操作的一般步骤和应用实例。
　　9.1　控件的拖放支持
　　拖放操作中控件可以分为源控件和目标控件两类。绝大部分控件既可以作为源控件
也可以作为目标控件。但也有一部分控件只能支持其中的一种。
　　9.1.1拖放属性
　　拖放属性主要有两个：
　　●DragMode：拖动模式
　　 它们都是在拖放的源控件中设置。DragMode控制用户在运行时间内当在控件上按
   下鼠标时控件如何反应。
    如果DragMode置为dmAutomatic，那么当用户在控件上按下鼠
   标时拖动自动开始；
    如果DragMode置为dmManual(这是缺省值)，则将通过处理鼠标事件
   来判断一个拖动是否可以开始。
　　●DragCursor
    用于选择拖动时显示的光标，缺省值是CrDrag，一般不要去修改它。
   在程序设计过程中通用的界面规范应该得到开发者的尊重。但有时候为了特定的目的，
   开发者也可以把自己设计的光标赋给DragCursor。
　　9.1.2拖放事件
　　拖放事件主要有三个(?)：
   ●OnDragOver：拖动经过时激发
   ●OnDragDrop：拖动放下时激发
   ●OnEndDrag：拖动结束时激发
   ●OnStartDrag：拖动开始时激发(?)
　　前两个事件由目标控件响应，后一个事件由源控件响应。
●OnDragOver事件最主要的功能是确定当用户就地放下拖动时控件是否可以接受。
它的参数包括：
　　Source：TObject；　{源控件}
   X，Y：Integer; {光标位置}
   State：TDragState；{拖动状态}
   var Accept：Boolean {能否接受}
　　●TDragState是一个枚举类型，表示拖放项目与目标控件的关系。
　　type TDragState = (dsDragEnter, dsDragLeave, dsDragMove);
　　不同取值的意义如下表：
　　表9.1 DragState的取值与意义
　　━━━━━━━━━━━━━━━━━━━━━━━━━━━
　　取值意义
　　───────────────────────────
　　dsDragEnter拖动对象进入一个允许拖动对象放的控件中。为缺省状态。
　　dsDragLeave拖动对象离开一个允许拖动对象放下的控件。
　　dsDragMove拖动对象在一个允许拖动对象放下的控件内移动。
　　━━━━━━━━━━━━━━━━━━━━━━━━━━━
　　用户可以利用提供的参数来确定放下的拖动是否可被接受，如：

　　●判断源控件类型：
　　Accept := Source is TLabel;
　　●判断源控件对象：
　　Accept := (Source = TabSet1);
　　●判断光标位置：
　　见(9.2),(9.3)中的例程。
　　●判断拖动状态：
　　If (Source is TLabel) and (State = dsDragMove) then
　　begin
    source.DragIcon := ' New.Ico ';
    Accept := True;
　　end
　　else
　　 Accept := False;

　　当Accept=True时，目标控件可以响应OnDragDrop事件，用于确定拖动被放下后程序
如何进行处理。
●OnDragDrop事件处理过程的参数包括源控件和光标位置。这些信息可用于处理方式的确定。
本篇文章来源于 www.87717.com 原文链接：http://www.87717.com/delphi/delphi_9716.html
●OnEndDrag事件是在拖动操作结束后由源控件来进行响应的，用于源控件进行相应的
处理。拖动操作结束既包括拖动放下被接受，也包括用户在一个不能接受放下的控件上释
放了鼠标。该事件处理过程的参数包括目标控件(Target)和放下位置的坐标。如果
Target=nil, 表示拖动项目没有被任何控件接受。
　　在第3节将介绍的文件拖放移动、拖放拷贝操作中，如果操作成功，则文件列表框
应更新显示内容。下面这段程序用于实现这一功能。
procedure TFMForm.FileListEndDrag(Sender, Target: TObject; X, Y: Integer);
begin
if Target <> nil then FileList.Update;
end;
●除以上介绍的三个事件外，还有一个事件OnMouseDown也常用于拖放操作的响应。
　　OnMouseDown虽然不是一个专门的拖放事件，但在人工模式下拖动的开始是在这一
事件的处理过程中实现的。
　　9.1.3拖放方法:人工方式
　　拖放方法有三个：
　　●BeginDrag：人工方式下开始一个拖动
　　●EndDrag：结束一个拖动
　　●Dragging：判断一个控件是否正被拖动
　　这三个方法都被源控件使用。
　　当DragMode置为dmManual时，拖动必须调用控件的BeginDrag方法才能开始。
●BeginDrag有一个布尔参数Immediate。如果输入参数为True，拖动立即开始，光标
改变到DragCursor的设置。如果输入参数为False，直到用户将光标移动了一定的距离
(5个象素点)后才改变光标，开始拖动。这就允许控件接受一个OnClick事件而并不开始
拖动操作。
●EndDrag方法中止一个对象的被拖动状态。它有一个布尔参数Drop。如果Drop设置
为True，被拖动的对象在当前位置放下(能否被接受由目标控件决定)；如果Drop设置
为False，则拖动就地被取消。
　　下面一段程序表明当拖动进入一控制面板时拖动被取消。
procedure TForm1.Panel1DragOver(Sender, Source: TObject; X, Y: Integer;
   State: TDragState; var Accept: Boolean);
begin
Accept := False;
if (Source is TLabel) and (State = dsDragEnter) then
   (Source as TLabel).EndDrag(False);

end;
●Draging方法判断一个控件是否正被拖动。在下面的例子中当用户拖动不同的检查框
时窗口改变为不同的颜色。
procedure TForm1.FormActivate(Sender: TObject);
begin
CheckBox1.DragMode := dmAutomatic;
CheckBox2.DragMode := dmAutomatic;
CheckBox3.DragMode := dmAutomatic;
end;
procedure TForm1.FormDragOver(Sender, Source: TObject; X, Y: Integer;
   State: TDragState; var Accept: Boolean);
begin
if CheckBox1.Dragging then
   Color := clAqua;
if CheckBox2.Dragging then
   Color := clYellow;
if CheckBox3.Dragging then
   Color := clLime;
end;
本篇文章来源于 www.87717.com 原文链接：http://www.87717.com/delphi/delphi_9716_2.html

例子:

对于上述的鼠标操作，我举一个例子。
例如模拟“鼠过留痕”（单击第一下鼠标，鼠标不管移动到哪里都会留下痕迹，单击第二下，就不再留下痕迹）。
unit Unit1;

interface
uses
Windows，Messages，SysUtils，Classes，Graphics，Controls，Forms，Dialogs;
type
　TForm1=class(TForm)
　　procedure FormCreate(Sender:TObject);
　　procedure FormMouseDown(Sender:TObject;Buttom:TMouseButton;
     Shift:TShiftState;X，Y:Integer);
   procedure FormMouseUp(Sender:TObject;Buttom:TMouseButton;
     Shift:TShiftState;X，Y:Integer);
private
　　{Private declarations}
　　public
　　{Public declarations}
　end;
var
Form1:TForm1;

implementation
{＄R ＊.DFM}
var
　Canvas:TCanvas;
　Flag:Boolean;
procedure TForm1.FormCreate(Sender:TObject);
begin
　Flag:=False;
end;

procedure TForm1.FormMouseDown(Sender:TObject;Buttom:TMouseButton;
   Shift:TShiftState;X，Y:Integer);
begin
if Flag=False Then
　begin
　　Canvas.MoveTo(X，Y);
　　Flag:=Ture;
　end
　else
　　Flag:=false;
end;

procedure TForm1.FormMouseUp(Sender:TObject;Buttom:TMouseButton;
   Shift:TShiftState;X，Y:Integer);
begin
　if Flag=Ture Then
　begin
　　Canvas.Pen.Color:=clBlack;
　　Canvas.LineTo(X，Y);
　end;
end;

end.

两种方式实现拖曳：用七个事件分裂成两种方法（七武器）
//第一种：onmousedown，onmouseup，onmousemove
//第二种：OnStartDrag,OnEndDrag,OnDragDrop,OnDragOver

第一种：onmousedown，onmouseup，onmousemove
{
2008-06-28 20:00
onmousedown，onmouseup和onmousemove

delphi下如何实现动态对象的拖拽
昨天上午写了一个小程序，模仿delphi设计阶段组件的拖拽，实现了动态创建对象的拖拽。
首先动态创建三个TLabel对象，并且保存到TList中，分别设置他们的onmousedown，onmouseup和onmousemove事件。
}
type
TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
private
    { Private declarations }
    lstMyRect : TList;                        //类似于控件数组
    Flag_Dragging : boolean;        
    StartPoint, LastPoint : TPoint;   //记录鼠标按下的点和移动后的点
    NowRect : TRect;                       //组件对象的边框
    procedure PrepareToMove(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
    procedure Moving(Sender: TObject; Shift: TShiftState; X,
        Y: Integer);
    procedure MoveEnd(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
public
    { Public declarations }
end;

procedure TForm1.FormCreate(Sender: TObject);
var
    s : string;
    i : integer;
    TempLabel : TLabel;
begin
    Flag_Dragging := False;

    lstMyRect := TList.Create; //动态创建TLabel对象，并保存
    for i := 0 to 2 do
    begin
        tempLabel := TLabel.Create(Sender as TForm);
        tempLabel.Caption := 'i love you';
        tempLabel.Top := 100 + i * 50;
        tempLabel.Left := 100 + i * 50;
        tempLabel.Parent := Form1;
        tempLabel.OnMouseDown := PrepareToMove; //设置三个事件
        tempLabel.OnMouseMove := Moving;
        tempLabel.OnMouseUp := MoveEnd;
        lstMyRect.Add(tempLabel);
    end;
end;

{当鼠标按下时，记录下开始点，并得到组件对象的边框，在移动的时候给用户以参照，并且把该边框画出}

procedure TForm1.PrepareToMove(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
    TmpLabel : TLabel;
begin
    TmpLabel := Sender as TLabel;
    Flag_Dragging := True;
    StartPoint := Point(X, Y);
    LastPoint := Point(X, Y);
    NowRect := Rect(TmpLabel.Left, TmpLabel.Top,
        TmpLabel.Left + TmpLabel.Width, TmpLabel.Top + TmpLabel.Height);
    Form1.Canvas.DrawFocusRect(NowRect);
end;
{当鼠标移动的时候，计算出移动的距离，消隐上一个位置的边框，计算新位置的边框并画出}

procedure TForm1.Moving(Sender: TObject; Shift: TShiftState;
X,Y: Integer);
var
    TmpLabel : TLabel;
    DeltaX, DeltaY : integer;
begin
    TmpLabel := Sender as TLabel;
    if Flag_Dragging then
    begin
        DeltaX := X - LastPoint.X; //计算移动的横纵距离
        DeltaY := Y - LastPoint.Y;
        LastPoint := Point(X, Y);   //保存新点
        Form1.Canvas.DrawFocusRect(NowRect); //消隐上一个位置的边框
        NowRect := Rect(NowRect.Left + DeltaX, NowRect.Top + DeltaY,
                        NowRect.Right + DeltaX, NowRect.Bottom + DeltaY);//计算新边框的位置
        Form1.Canvas.DrawFocusRect(NowRect);
    end;
end;

{当鼠标放开时，不用再画边框，直接计算释放处与开始处的距离，然后把组件对象移动过来}

procedure TForm1.MoveEnd(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
var
    TmpLabel : TLabel;
    Deltax, Deltay : integer;
begin
    TmpLabel := Sender as TLabel;
    if Flag_Dragging then
    begin
        Flag_Dragging := False;
        LastPoint := Point(X, Y);
        Deltax := LastPoint.X - StartPoint.X;
        Deltay := LastPoint.Y - StartPoint.Y;
        TmpLabel.Top := Deltay + TmpLabel.Top; //重新设置组件对象的位置
        TmpLabel.Left := Deltax + TmpLabel.Left;
    end;
end;

第二种：OnStartDrag,OnEndDrag,OnDragDrop,OnDragOver
{
2008-06-28 20:08

OnStartDrag,OnEndDrag,OnDragDrop,OnDragOver

在delphi中实现托拽
版权声明：转载时请以超链接形式标明文章原始出处和作者信息及本声明
http://kris.blogbus.com/logs/31441.html
我的理解是这样的,OnStartDrag-->OnDragOver-->OnDragDrop
开始拉,然后是在control的上面拉,最后是放下,
其中Drop处,对应的是最后被托拽物体所要释放到的control名(即是Target),
要把物体的parent设成对应的Control名,否则无法实现drag,
另外在Over事件中,要求把Accept变量设成True,才可以托拽;
}
//***********************************************************************************
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jpeg, ExtCtrls;

type
TForm1 = class(TForm)
   Panel1: TPanel;
   Panel2: TPanel;
   Memo1: TMemo;
   Image1: TImage;
   Edit1: TEdit;
   Button1: TButton;
   procedure Panel1DragDrop(Sender, Source: TObject; X, Y: Integer);
   procedure Panel1DragOver(Sender, Source: TObject; X, Y: Integer;
    State: TDragState; var Accept: Boolean);
   procedure Panel2DragDrop(Sender, Source: TObject; X, Y: Integer);
   procedure Panel2DragOver(Sender, Source: TObject; X, Y: Integer;
    State: TDragState; var Accept: Boolean);
   procedure Button1StartDrag(Sender: TObject;
   var DragObject: TDragObject);
   procedure Image1StartDrag(Sender: TObject;
   var DragObject: TDragObject);
   procedure Edit1StartDrag(Sender: TObject; var DragObject: TDragObject);
private
{ Private declarations }
   obj :String;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Panel1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
if obj = 'btn' then
begin
   button1.Left :=x;
   button1.Top :=y;
   button1.Parent :=panel2;
end;

if obj = 'edit' then
begin
   edit1.Left :=x;
   edit1.Top :=y;
   edit1.Parent :=PANEL1;
end;

if obj='img' then
begin
   image1.left :=x;
   image1.Top:=y;
   image1.Parent :=panel1;
end;
memo1.Lines.Add('Panel1 - drop' +IntToStr(x)+'='+IntToStr(y));
end;

procedure TForm1.Panel1DragOver(Sender, Source: TObject; X, Y: Integer;
   State: TDragState; var Accept: Boolean);
begin
Accept :=true;
Memo1.Lines.Add('Panel1 - over' +IntToStr(x) +'='+IntToStr(y));
end;

procedure TForm1.Panel2DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
if obj = 'btn' then
begin
   button1.Left :=x;
   button1.Top :=y;
   button1.Parent :=panel2;
end;

if obj = 'edit' then
begin
   edit1.Left :=x;
   edit1.Top :=y;
   edit1.Parent :=PANEL2;
end;

if obj='img' then
begin
   image1.left :=x;
   image1.Top:=y;
   image1.Parent :=panel2;
end;
memo1.Lines.Add('Panel2 - drop' +inttostr(x)+'='+inttostr(y));
end;

procedure TForm1.Panel2DragOver(Sender, Source: TObject; X, Y: Integer;
   State: TDragState; var Accept: Boolean);
begin
Accept :=true;
Memo1.Lines.Add('Panel2 - over' +IntToStr(x) +'='+IntToStr(y));
end;

procedure TForm1.Button1StartDrag(Sender: TObject;var DragObject: TDragObject);
begin
obj :='btn';
// ShowMessage('Start Drag');
end;

procedure TForm1.Image1StartDrag(Sender: TObject;var DragObject: TDragObject);
begin
obj :='img';
end;

procedure TForm1.Edit1StartDrag(Sender: TObject;var DragObject: TDragObject);
begin
obj :='edit';
end;

end.