VCL中DragDrop功能的底层实现.doc

VCL中DragDrop功能的底层实现前段时间在论坛里看了一篇关于剖析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函数接收的实现代码： procedure DragInit(ADragObject: TDragObject; Immediate: Boolean; Threshold: Integer); begin / 在全局变量中保存参数 DragObject := ADragObject; DragObject.DragTarget := nil; GetCursorPos(DragStartPos); DragObject.DragPos := DragStartPos; DragSaveCursor := Windows.GetCursor; / ! DragCapture := DragObject.Capture; / 启动DragDrop管理核心 / ! DragThreshold := Threshold; if ADragObject is TDragDockObject then begin . / DragDock控制部分 end else begin if Immediate then ActiveDrag := dopDrag / 直接进入DragDrop操作 else ActiveDrag := dopNone; end; / - 以下部分可以忽略 DragImageList := DragObject.GetDragImages; if DragImageList nil then with DragStartPos do DragImageList.BeginDrag(GetDeskTopWindow, X, Y); QualifyingSites := TSiteList.Create; / - if ActiveDrag dopNone then DragTo(DragStartPos); end; 到此，便完全由TDragControlObjectEx（由全局变量DragObject保存）控制整个DragDrop操作；当DragObject检测到鼠标移动消息（WM_MOUSEMOVE）时，便会调用DragTo函数；DragTo函数查找鼠标所在位置的VCL控件，并产生DragOver事件。 5、DragTo函数 procedure DragTo(const Pos: TPoint); function GetDropCtl: TControl; begin . end; var DragCursor: TCursor; / Target: TControl; / 鼠标所在位置（Pos）的VCL控件 TargetHandle: HWND; / 控件的句柄 DoErase: Boolean; / 是否执行擦除背景操作 begin / 只有当Drag操作为dopDrag或dopDock，或鼠标移动量大于Threshold(传递给BeginDrag的值)时， / 才执行后面的操作 if (ActiveDrag dopNone) or (Abs(DragStartPos.X - Pos.X) = DragThreshold) or (Abs(DragStartPos.Y - Pos.Y) = DragThreshold) then begin / 查找鼠标当前位置的VCL控件 Target := DragFindTarget(Pos, TargetHandle, DragControl.DragKind, DragControl); / - / 如果尚未开始Drag，则初始化图像列表为Dragging状态 if (ActiveDrag = dopNone) and (DragImageList nil) then with DragStartPos do DragImageList.BeginDrag(GetDeskTopWindow, X, Y); / - if DragControl.DragKind = dkDrag then begin ActiveDrag := dopDrag; DoErase := False; / Drag操作只改变鼠标形状，不需要迫擦除移动框的背景 end else begin . end; / 如果鼠标位置移动前后所在的VCL控件不同 if Target DragObject.DragTarget then begin DoDragOver(dmDragLeave); / 原来的控件产生DragOver(dmDragLeave离开)事件 if DragObject = nil then Exit; DragObject.DragTarget := Target; DragObject.DragHandle := TargetHandle; DragObject.DragPos := Pos; DoDragOver(dmDragEnter); / 新位置的控件产生DragOver(dmDragEnter进入)事件 if DragObject = nil then Exit; end; / 计算Drag的当前位置 DragObject.DragPos := Pos; if DragObject.DragTarget nil then DragObject.DragTargetPos := TControl(DragObject.DragTarget).ScreenToClient(Pos); / 获取Drag操作的鼠标形状 / 注意GetDragCursor的参数，它的参数正在DragOver(dmDragMove移动)事件的返回值 DragCursor := TDragObject(DragObject).GetDragCursor(DoDragOver(dmDragMove), Pos.X, Pos.Y); /- 可以暂时忽略 if DragImageList nil then begin if (Target = nil) or (csDisplayDragImage in Target.ControlStyle) then begin DragImageList.DragCursor := DragCursor; if not DragImageList.Dragging then DragImageList.BeginDrag(GetDeskTopWindow, Pos.X, Pos.Y) else DragImageList.DragMove(Pos.X, Pos.Y); end else begin DragImageList.EndDrag; Windows.SetCursor(Screen.CursorsDragCursor); end; end; / - Windows.SetCursor(Screen.CursorsDragCursor); if ActiveDrag = dopDock then begin . / DragDock相关部分 end; end; end; 从代码中，我们可以看出DragTo函数的工作分为两个部分：一是判断是否已经进入了Drag状态中，否则检查是否满足进入Drag状态的条件；二是查找鼠标当前位置的VCL控件，判断鼠标前后位置所在的VCL控件，并产生相应的事件。 当DragObject检测到鼠标放开消息（WM_LBUTTONUP, WM_RBUTTONUP）或ESC键按下消息（CN_KEYDOWN + K_ESCAPE）时，调用DragDone函数结束Drag操作。 6、DragDone函数 DragDone函数接收一个Drop参数，该参数指明是否使目标控件产生DragDrop事件 procedure DragDone(Drop: Boolean); / - DragDock相关部分 function CheckUndock: Boolean; begin Result := DragObject.DragTarget nil; with DragControl do if Drop and (ActiveDrag = dopDock) then if Floating or (FHostDockSite = nil) then Result := True else if FHostDockSite nil then Result := FHostDockSite.DoUnDock(DragObject.DragTarget, DragControl); end; / - var DockObject: TDragDockObject; Accepted: Boolean; / 目标控件是否接受DragDrop操作 DragMsg: TDragMessage; TargetPos: TPoint; / ParentForm: TCustomForm; begin DockObject := nil; Accepted := False; / 防止递归调用 / 检查DragObject的Canceling属性，如为真则直接退出 if (DragObject = nil) or DragObject.Cancelling then Exit; try DragSave := DragObject; / 保存当前DragDrop控制对象 try DragObject.Cancelling := True; / 设置Cancelling标志，表示正在执行DragDone操作 DragObject.FDropped := Drop; / 在目标控件上释放标志 / ! DragObject.ReleaseCapture(DragCapture); / 停止DragDrop管理核心 / ! if ActiveDrag = dopDock then begin . / DragDock相关部分 end; / 取得Drag的位置 if (DragObject.DragTarget nil) and (TObject(DragObject.DragTarget) is TControl) then TargetPos := DragObject.DragTargetPos else TargetPos := DragObject.DragPos; / 目标控件是否接受Drop操作 / 当Drag操作为dopDrag时，目标控件产生DoDragOver(dmDragLeave离开)事件 / 若传递给DragDone的Drop参数为False时，Accepted恒为False Accepted := CheckUndock and (ActiveDrag = dopDock) and DockObject.Floating) or (ActiveDrag dopNone) and DoDragOver(dmDragLeave) and Drop; if ActiveDrag = dopDock then begin . / DragDock相关操作 end else begin / - if DragImageList nil then DragImageList.EndDrag else Windows.SetCursor(DragSaveCursor); / - end; DragControl := nil; DragObject := nil; if Assigned(DragSave) and (DragSave.DragTarget nil) then begin DragMsg := dmDragDrop; / 产生DragDrop事件 if not Accepted then/ 如果Accepted为False，则不产生DragDrop事件 begin / 实际上在VCL中没有处理dmDragCancel的相关代码 DragMsg := dmDragCancel;/ 即dmDragCancel只是一个保留操作 DragSave.FDragPos.X := 0; DragSave.FDragPos.Y := 0; TargetPos.X := 0; TargetPos.Y := 0; end; DragMessage(DragSave.DragHandle, DragMsg, DragSave, DragSave.DragTarget, DragSave.DragPos); end; finally / - QualifyingSites.Free; QualifyingSites := nil; / - if Assigned(DragSave) then begin DragSave.Cancelling := False; DragSave.Finished(DragSave.DragTarget, TargetPos.X, TargetPos.Y, Accepted); / 产生EndDrag事件 end; DragObject := nil; end; finally DragControl := nil; if Assigned(DragSave) and (DragSave is TDragControlObjectEx) or (DragSave is TDragObjectEx) or (DragSave is TDragDockObjectEx) then DragSave.Free; ActiveDrag := dopNone; end; end; 至此，与DragDrop核心的接口函数已介绍完毕；我们留意到在这些几个函数中还调用了DragFindTarget、DoDragOver、DragMessage几个函数，这些函数的源码在Control.pas中，功能分别如下： DragFindTarget：(const Pos: TPoint; var Handle: HWND; DragKind: TDragKind; Client: TControl): Pointer; 根据DragKind的类型查找Pos位置的VCL控件（由函数返回值返回），Handle返回控件的句柄。 DoDragOver：(DragMsg: TDragMessage): Boolean; 产生目标控件的DragOver事件。 DragMessage：(Handle: HWND; Msg: TDragMessage; Source: TDragObject; Target: Pointer; const Pos: TPoint): Longint; 发送Drag相关的消息到Drag控件。 7、DragDrop管理核心 下面的部分将是DragDrop管理的核心部分介绍。先来看一直管理核心类的定义及继承关系： TDragObject = class(TObject); TDragObjectEx = class(TDragObject); TBaseDragControlObject = class(TDragObject); TDragControlObject = class(TBaseDragControlObject); TDragControlObjectEx = class(TDragControlObject); 这里只对TDragObject类的DragDrop控制实现过程作详细介绍，其他部分及其他类的实现就不多作介绍。 在DragInit函数中有这么一句调用： DragCapture := DragObject.Capture; TDragObject.Capture调用AllocateHWND函数创建了一个内部不可见窗口（Delphi习惯上称为TPUtilWindow），并设置该窗口句柄为Capture窗口，以接收应用程序的所有鼠标和键盘输入消息，实现Drag控制。下面是其实现代码： function TDragObject.Capture: HWND; begin Result := Classes.AllocateHWND(MainWndProc); SetCapture(Result); end; 与TDragObject.Capture对应，有一个TDragObject.ReleaseCapture函数，在DragDone有相应调用： DragObject.ReleaseCapture(DragCapture); TDragObject.Capture结束DragDrop控制，函数中首先释放系统的Capture句柄，并调用DeallocateHWND释放由AllocateHWND创建的窗口。 当调用WinAPI函数SetCapture将一个窗口（句柄）设置为Capture模式后，系统的所有鼠标、键盘输入消息都将发送到该窗口中，VCL的DragDrop操作便是基于这样的原理来实现的。当调用了TControl.BeginDrag函数后，随后的几个函数设置DragDrop操作所需的参数，并创建了一个这样的Capture窗口，直到这时，鼠标的按键一直是按下的，当Capture窗口接收到鼠标按键释放或ESC键按下的消息时，便结束了DragDrop操作。 我们再来看一下TDragObject的消息处理函数TDragObject.W