核心提示:一、与DragDrop操作相关的属性、事件、函数 VCL的DragDrop功能是在TControl类中现的,因此所有从TControl类派生出来的控件类者继承了这些属性、事件和函数,包括: 属性:Dr...
一、与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.Cursors[DragCursor]);
end;
end;
// 〈-
Windows.SetCursor(Screen.Cursors[DragCursor]);
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.WndProc:
procedure TDragObject.WndProc(var Msg: TMessage);
var
P: TPoint;
begin
try
case Msg.Msg of
// 鼠标移动时调用DragTo函数,检查鼠标位置的VCL控件并产生相应的事件ss
WM_MOUSEMOVE:
begin
P := SmallPointToPoint(TWMMouse(Msg).Pos);
ClientToScreen(DragCapture, P);
DragTo(P);
end;
// 系统的Capture窗口改变或鼠标按键释放时结束DragDrop操作
WM_CAPTURECHANGED:
DragDone(False); // 取消Drag
WM_LBUTTONUP, WM_RBUTTONUP:
DragDone(True); // 结束Drag并产生DragDrop事件
// 当一个TPUtilWindow获得鼠标Capture时,Forms.IsKeyMsg向其发送所有的键盘消息,
// 但是这些键盘消息都加上了CN_BASE,变成了CN_KEYxxx
// 如果Ctrl键按下或释放,
CN_KEYUP:
if Msg.WParam = VK_CONTROL then DragTo(DragObject.DragPos);
CN_KEYDOWN:
begin
case Msg.WParam of
VK_CONTROL:
DragTo(DragObject.DragPos);
VK_ESCAPE:
begin
{ Consume keystroke and cancel drag operation }
Msg.Result := 1;
DragDone(False); // ESC键按下,取消Drag操作
end;
end;
end;
end;
except
if DragControl <> nil then DragDone(False);
Application.HandleException(Self);
end;
end;
8、小结
通过全文的介绍,可以总结出下图:
TControl.BeginDrag
|
DragInitControl --> { TDragObject.Create; }
|
DragInit --> { TDragObject.Capture; }
|
|---------->|
| TDragObject.WinProc ---> WM_MOUSEMOVE ===> DragTo
| | |
|----------<| |-> WM_CAPTURECHANGED ===> DragDone(False)
| |
DragDone |-> WM_LBUTTONUP, WM_RBUTTONUP ==> DragDone(True)
|
|-> CN_KEYUP(VK_CONTROL) ===> DragTo
|
|-> CN_KEYDOWN(VK_CONTROL) ===> DragTo
|
|-> CN_KEYDOWN(VK_ESCAPE) ===> DragDone(False)