谈VCL中DragDrop功能的底层实现

  • A+
所属分类:[开发技巧]

前段时间在论坛里看了一篇关于剖析VCL结构的文件,其中不少高手的开怀畅谈让小辈们心里感觉非常的痛快!看完余又觉得不能光看,也该将自己的心得拿出来与大家分享,于是就边夜翻看VCL源码,终于将VCL如何实现DragDrop功能的过程弄个“基本明白”,其中可能会有不当之处,再加上小弟的文学水平也只是初中毕业,有些地方也许会表达不当,但其意思也基本上八九不离十了,故也请大家开怀畅言、批评指正,都是为了进步嘛!哈哈……

虽然DragDock操作与DragDrop操作是密切相关,并且很大一部分操作是相同的,但本文暂且不讨论与DragDock有关的部分,留待下回分解或也给大家表现表现………………

一、与DragDrop操作相关的属性、事件、函数

VCL的DragDrop功能是在TControl类中现的,因此所有从TControl类派生出来的控件类者继承了这些属性、事件和函数,包括:

属性:DragCursor: Drag时的鼠标类型:(TCursor);
DragKind: Drag的类型:(dkDrag, dkDock);
DragMode: Drag的方式:手动(dmManual)或自动(dmAutomatic);

事件:OnStartDrag:Drag开始事件;
OnDragOver: Drag经过某个控件;
OnDragDrop: Drag到某个控件并放开;
OnEndDrag: Drag动作结束;

函数:BeginDrag: 开始控件的Drag动作;
Dragging: 返回控件是否正被Dragging;
CancelDrag: 取消正在执行的Drag操作;
EndDrag: 结束正在执行的Drag操作,与CancelDrag不同,EndDrag允许操作指定是否产生Drop操作(由Drop参数决定)。

此外还有一些与DragDrop相关的函数,在随后的介绍中将逐一说明。

二、DragDrop操作产生与执行的过程

1、自动产生过程。

我们知道在控件上单击鼠标左键时便会产生WM_LBUTTONDOWN消息,TControl类的WinProc消息处理方法捕捉到该消息时,便判断控件的DragMode是否为dmAutomatic,即是否自动执行DragDrop操作,如果是则调用类保护函数BeginAutoDrag,立即进入DragDrop状态,详见下面代码:

procedure TControl.WndProc(var Message: TMessage);
begin
...
case Message.Msg of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
begin
if FDragMode = dmAutomatic then
begin
BeginAutoDrag; // 进行DragDrop操作
Exit;
end;
Include(FControlState, csLButtonDown);
end;
...
else ... end;
...
end;

procedure TControl.BeginAutoDrag;
begin
BeginDrag(Mouse.DragImmediate, Mouse.DragThreshold);
end;

从上面代码可知它只是简单的调用了BeginDrag函数,具体开始DragDrop是由BeginDrag函数执行的。

2、手动产生过程。

当DragMode为dmManual时,将由程序在代码中显式调用BeginDrag方法产生。如:

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Panel1.BeginDrag(True, -1);
end;

3、BeginDrag函数

分析前请先留意在 Controls 单元中声明的几个全局变量:
var
DragControl: TControl; // 被Drag的控件
DragObject: TDragObject; // 管理整个DragDrop过程的TDragObject对象
DragInternalObject: Boolean; // TDragObject对象是否由内部创建
DragCapture: HWND; // 管理DragDrop过程的Wnd实例句柄
DragStartPos: TPoint; // Drag开始时的鼠标位置
DragSaveCursor: HCURSOR; // Drag开始的的鼠标类型
DragThreshold: Integer; // Drag操作延迟位置
ActiveDrag: TDragOperation; // 正在执行的Drag操作:(dopNone, dopDrag, dopDock);
DragImageList: TDragImageList; // Drag过程中代替鼠标显示的图像列表

BeginDrag的函数原型声明为:
procedure BeginDrag(Immediate: Boolean; Threshold: Integer = -1);

参数:
Immediate:是否直接进入DragDrop状态;
Threshold:若Immediate参数为False,当鼠标移动量超过Threshold给出的值时进入DragDrop状态;

且先看其实现代码:
procedure TControl.BeginDrag(Immediate: Boolean; Threshold: Integer);
var
P: TPoint;
begin
// DragDrop操作的对象不允许是窗体

if (Self is TCustomForm) and (FDragKind <> dkDock) then
raise EInvalidOperation.CreateRes(@SCannotDragForm);

// 前面提过暂且不讨论DragDock相关部分,所以对CalcDockSizes的函数调用不作分析。
CalcDockSizes;

// DragControl 不为 nil 或 Pointer($FFFFFFFF) 说明已经进入了DragDrop状态
// 这里的判断避免了递归调用

if (DragControl = nil) or (DragControl = Pointer($FFFFFFFF)) then
begin
DragControl := nil;

// 如果被Drag控件处于鼠标按下状态(如前面的手动产生方式)时应先清除其状态
//
if csLButtonDown in ControlState then
begin
GetCursorPos(P);
P := ScreenToClient(P);
Perform(WM_LBUTTONUP, 0, Longint(PointToSmallPoint(P)));
end;

{ 如果传递的Threshold变量小于0,则使用系统默认的值 }
if Threshold < 0 then
Threshold := Mouse.DragThreshold;

// 以Pointer($FFFFFFFF)为标志防止在BeginDrag中调用EndDrag
if DragControl <> Pointer($FFFFFFFF) then
DragInitControl(Self, Immediate, Threshold); // !!!!!!
end;

end;

在BeginDrag的最后一行代码,由TControl类转入全局函数DragInitControl中。函数DragInitControl、DragInit、DragTo、DragDone共同组成了DragDrop核心与VCL类的交互接口。

4、DragInitControl、DragInit函数

DragInitControl函数接收了BeginDrag函数的Immediate和Threshold参数,还多了一个Control参数,该参数但是被Drag的控件。下面来看DragInitControl函数的实现代码:

procedure DragInitControl(Control: TControl; Immediate: Boolean; Threshold: Integer);
var
DragObject: TDragObject;
StartPos: TPoint;
begin
DragControl := Control;
try
DragObject := nil;
DragInternalObject := False;
if Control.FDragKind = dkDrag then
begin
Control.DoStartDrag(DragObject); // 产生StartDrag事件
if DragControl = nil then Exit;
if DragObject = nil then
begin
DragObject := TDragControlObjectEx.Create(Control);
DragInternalObject := True;
end
end
else begin
... // DragDock控件部分
end;
DragInit(DragObject, Immediate, Threshold);
except
DragControl := nil;
raise;
end;
end;

DragInitControl函数只是简单地进行一些判断然后调用TControl的DoStartDrag函数(该函数产生的OnStartDrag事件)并创建TDragControlObjectEx对象,就直接进入了DragInit函数,也就是真正由VCL控件类进入DragDrop管理核心的部分。
TDragControlObjectEx的内部保存了被Drag的控件及执行DragDrop的所需的其他参数,该类的实现及内部功能我们稍候再介绍。

DragInit函数接收

  • 我的微信
  • 这是我的微信扫一扫
  • weinxin
  • 我的微信公众号
  • 我的微信公众号扫一扫
  • weinxin
广告也精彩
avatar
广告也精彩

发表评论

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen: