1、VCL 中 DragDrop 功能的底层实现前段时间在论坛里看了一篇关于剖析 VCL 结构的文件，其中不少高手的开怀畅谈让小辈们心里感觉非常的痛快！看完余又觉得不能光看，也该将自己的心得拿出来与大家分享，于是就边夜翻看 VCL 源码，终于将 VCL 如何实现 DragDrop 功能的过程弄个“基本明白”，其中可能会有不当之处，再加上小弟的文学水平也只是初中毕业，有些地方也许会表达不当，但其意思也基本上八九不离十了，故也请大家开怀畅言、批评指正，都是为了进步嘛！哈哈虽然 DragDock 操作与 DragDrop 操作是密切相关，并且很大一部分操作是相同的，但本文暂且不讨论与 DragDock
2、有关的部分，留待下回分解或也给大家表现表现一、与 DragDrop 操作相关的属性、事件、函数VCL 的 DragDrop 功能是在 TControl 类中现的，因此所有从 TControl 类派生出来的控件类者继承了这些属性、事件和函数，包括：属性：DragCursor: Drag 时的鼠标类型：（TCursor）;DragKind: Drag 的类型： (dkDrag, dkDock);DragMode: Drag 的方式：手动 (dmManual）或自动（dmAutomatic);事件：OnStartDrag：Drag 开始事件；OnDragOver： Drag 经过某个控件；OnDra
3、gDrop： Drag 到某个控件并放开；OnEndDrag： Drag 动作结束；函数：BeginDrag： 开始控件的 Drag 动作；Dragging： 返回控件是否正被 Dragging；CancelDrag： 取消正在执行的 Drag 操作；EndDrag： 结束正在执行的 Drag 操作，与 CancelDrag 不同，EndDrag 允许操作指定是否产生 Drop 操作（由 Drop 参数决定） 。此外还有一些与 DragDrop 相关的函数，在随后的介绍中将逐一说明。二、DragDrop 操作产生与执行的过程1、自动产生过程。我们知道在控件上单击鼠标左键时便会产生 WM_LBU
4、TTONDOWN 消息，TControl 类的WinProc 消息处理方法捕捉到该消息时，便判断控件的 DragMode 是否为 dmAutomatic，即是否自动执行 DragDrop 操作，如果是则调用类保护函数 BeginAutoDrag，立即进入DragDrop 状态，详见下面代码：procedure TControl.WndProc(var Message: TMessage);begin.case Message.Msg ofWM_LBUTTONDOWN, WM_LBUTTONDBLCLK:begin if FDragMode = dmAutomatic thenbeginBegi
5、nAutoDrag; / 进行 DragDrop 操作Exit;end;Include(FControlState, csLButtonDown);end;.else . end;.end;procedure TControl.BeginAutoDrag;beginBeginDrag(Mouse.DragImmediate, Mouse.DragThreshold);end;从上面代码可知它只是简单的调用了 BeginDrag 函数，具体开始 DragDrop 是由BeginDrag 函数执行的。2、手动产生过程。当 DragMode 为 dmManual 时，将由程序在代码中显式调用 Beg
6、inDrag 方法产生。如：procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);beginPanel1.BeginDrag(True, -1);end;3、BeginDrag 函数分析前请先留意在 Controls 单元中声明的几个全局变量：varDragControl: TControl; / 被 Drag 的控件DragObject: TDragObject; / 管理整个 DragDrop 过程的 TDragObject 对象Dr
7、agInternalObject: Boolean; / TDragObject 对象是否由内部创建DragCapture: HWND; / 管理 DragDrop 过程的 Wnd 实例句柄DragStartPos: TPoint; / Drag 开始时的鼠标位置DragSaveCursor: HCURSOR; / Drag 开始的的鼠标类型DragThreshold: Integer; / Drag 操作延迟位置ActiveDrag: TDragOperation; / 正在执行的 Drag 操作：(dopNone, dopDrag, dopDock);DragImageList: TDra
8、gImageList; / Drag 过程中代替鼠标显示的图像列表BeginDrag 的函数原型声明为：procedure BeginDrag(Immediate: Boolean; Threshold: Integer = -1);参数：Immediate：是否直接进入 DragDrop 状态；Threshold：若 Immediate 参数为 False，当鼠标移动量超过 Threshold 给出的值时进入 DragDrop 状态；且先看其实现代码：procedure TControl.BeginDrag(Immediate: Boolean; Threshold: Integer);va
9、rP: TPoint;begin/ DragDrop 操作的对象不允许是窗体if (Self is TCustomForm) and (FDragKind 以下部分可以忽略DragImageList := DragObject.GetDragImages;if DragImageList dopNone) or (Abs(DragStartPos.X - Pos.X) = DragThreshold) or(Abs(DragStartPos.Y - Pos.Y) = DragThreshold) thenbegin/ 查找鼠标当前位置的 VCL 控件Target := DragFindTarg
10、et(Pos, TargetHandle, DragControl.DragKind, DragControl);/ -/ 如果尚未开始 Drag，则初始化图像列表为 Dragging 状态if (ActiveDrag = dopNone) and (DragImageList nil thenDragObject.DragTargetPos := TControl(DragObject.DragTarget).ScreenToClient(Pos);/ 获取 Drag 操作的鼠标形状/ 注意 GetDragCursor 的参数，它的参数正在 DragOver(dmDragMove移动)事件的
11、返回值DragCursor := TDragObject(DragObject).GetDragCursor(DoDragOver(dmDragMove),Pos.X, Pos.Y);/- 可以暂时忽略if DragImageList DragDock 相关部分function CheckUndock: Boolean;beginResult := DragObject.DragTarget nil thenResult := FHostDockSite.DoUnDock(DragObject.DragTarget, DragControl);end;/ nil) and(TObject(Dr
12、agObject.DragTarget) is TControl) thenTargetPos := DragObject.DragTargetPoselseTargetPos := DragObject.DragPos;/ 目标控件是否接受 Drop 操作/ 当 Drag 操作为 dopDrag 时，目标控件产生 DoDragOver(dmDragLeave离开)事件/ 若传递给 DragDone 的 Drop 参数为 False 时， Accepted 恒为 FalseAccepted := CheckUndock and(ActiveDrag = dopDock) and DockObject.Floating) or(ActiveDrag if DragImageList nil then DragImageList.EndDragelse Windows.SetCursor(DragSaveCursor);/ nil) thenbeginDragMsg := dmDragDrop; / 产生 DragDrop 事件if not Accepted then / 如果 Accepted 为 False，则不产生DragDrop 事件begin / 实际上在 VCL 中没有处理 dmDragCancel的相关代码
