前段時間在論壇裏看了一篇關於剖析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.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)