所謂?？烤褪强梢杂檬髽送蟿哟绑w或者控件，并將其從一個父窗體移出或者移動到另一個父窗體上，可以按水平，垂直方
向整齊排列， 并且可以?？吭诜猪摽刂平M件上。下面的示意圖是一個Delphi IDE的窗口?？渴疽鈭D：

考察一些常用的軟件如Office等大型軟件，會發現大多提供窗體?？康墓δ堋Ｎ④浀腗FC很早就引入了工具條的拖放功能，
可以將工具條上窗口上邊拖放到窗口下邊。而Borland則最早在Delphi 4中開始引入?？抗δ苤С?#xff0c;它實際上就是基于前
面我們講到的VCL拖放技術基礎之上的，后面我們會看到兩者有多么的類似。Borland提供了停靠功能的一個演示程序，
可以在..\Demos\Docking目錄下找到它，不過這個例子的問題就是太過復雜，使用了很多的高級技巧，不易理解。所以我
將拋開復雜的示例，一步一步的揭開停靠的秘密。

一個簡單的?？繉崿F

工具條的停靠功能是最常見的功能需求，新建一個程序，在窗體上放置一個工具條，然后任意添加幾個按鈕，為了讓工具條
能夠從窗體上移出，最簡單的辦法是設定工具條的DragMode屬性為dmAutomatic，將DragKind屬性設定為dkDock。就像在拖
放類一章我們說的，DragMode設定為dmAutomatic表示當鼠標在工具條上點擊并移動后，會自動發起拖放動作。而DragKind
為dkDock表示接下來的操作是一個?？坎僮鞫皇瞧胀ǖ耐戏挪僮?。

運行這個簡單的程序，然后拖放工具條，我們發現確實可以將工具條拖離主窗體使其變成一個浮動的工具條。注意在工具條
從窗體拖離時，VCL會在屏幕上畫一個矩形表示工具條，我們稱其為?？繄D像。見下圖：

?

可以看到，VCL強大的?？恐С质刮覀儾挥脤懸恍写a就可以實現簡單的?？抗δ芰?#xff0c;但是上面的程序存在幾個問題：

1、 由于使用了dmAutomatic屬性，哪怕是單擊一下工具條不做任何拖動，都會使它變成浮動的工具條。

2、 拖離窗體后變成浮動的工具條無法停靠回原來的位置。

3、 浮動的工具條窗口可以被關閉，而關閉后再也沒辦法調出工具條了。

對于第一個問題，為了實現工具條在鼠標點擊后，必須拖放幾個像素后才能被拖離界面，可以像前面拖放類章節中所講
的那樣，設定工具條的DragMode為dmManual的手工模式，然后在工具條的OnMouseDown事件中使用拖放函數BeginDrag來發起
拖離的動作：

procedure TForm1.ToolBar1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Toolbar1.BeginDrag(False);
end;

而為了讓浮動工具條能夠被停靠回主界面，我們需要設定窗體的DockSite屬性為True，表示窗體是一個?？康腻^點，允許
別的控件?？吭谒厦?。

而當關閉浮動工具條窗口時，VCL其實并沒有銷毀工具條，它只是將工具條的Visible屬性設為False，使其不可見，為
了重新顯示工具條，我們可以通過一個菜單命令，將其屬性設為True。下面是添加的察看工具條的Action的代碼，其中Update 事件判斷工具條是否可見，如果不可見，則允許執行Action的OnExecute事件：

procedure TForm1.ActionViewToolBarUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled:=not Toolbar1.Visible;
end;

procedure TForm1.ActionViewToolBarExecute(Sender: TObject);
begin
Toolbar1.Visible:=True;
end;
再次運行修改后的?？砍绦?#xff0c;多拖放?？繋状魏?#xff0c;我們又會發現一個新的問題，那就是雖然浮動工具條可以被停靠回主界面
，但是位置不再是同界面頂部對齊，而是可以停靠在任意位置上，這顯然不是我們想要的效果，什么原因造成的呢？怎么解
決呢？
原來，VCL在拖離任何控件后，都會將控件的Align屬性修改為alNone，要想解決這個問題，就需要在工具條?？吭诖绑w上之
后將工具條的Align屬性重新設定為alTop。幸好同拖放操作一樣，在停靠組件時，VCL同樣會產生一系列的事件，其中 OnEndDock事件會在停靠完成后發生，正好滿足我們的需要，實現的工具條的OnEndDock事件如下：

procedure TForm1.ToolBar1EndDock(Sender, Target: TObject; X, Y: Integer);
begin
Toolbar1.Align:=alTop;
end;
復雜界面的?？?br />上面的停靠功能可以滿足簡單界面的需求了，那么考慮一個復雜的界面停靠操作。假設你的項目經理要求你在主界面上放置
兩個面板，上面的面板上有一個工具條，下面的面板上也有一個工具條。兩個面板上的工具條都停靠操作，但是有一個要求
是上面面板的工具條只能停靠在上面的面板上，同樣下面的工具條也只能?？吭谙旅娴拿姘迳?。

當組件在要?？康慕M件上被拖動時，會調用被?？拷M件的OnDockOver事件， OnDockOver的事件定義如下；
type TDockOverEvent = procedure(Sender: TObject; Source:
TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean) of object;

其中Source是一個VCL在?？坎僮髦凶詣觿摻ǖ腡DragDockObject類型的對象，它的Control屬性就是?？拷M件，所以可以在組件的OnDockOver事件中根據要停靠的組件名稱判斷是否接收拖放。實現的判斷代碼如下：
procedure TForm1.Panel1DockOver(Sender: TObject; Source: TDragDockObject;

X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
Accept:=(Source.Control.Name='ToolBar1');
end;

procedure TForm1.Panel2DockOver(Sender: TObject; Source: TDragDockObject;
X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
Accept:=(Source.Control.Name='ToolBar2');
end;
執行程序后，可以發現確實Toolbar1不會被停靠到Panel2上。但是有一個問題，雖然Panel2不接收Toolbar1的停靠，但是VCL仍然會在修改Toolbar1的?？烤匦螢镻anel1的形狀，在實際使用中可能會讓用戶產生一種錯覺，以為可以?？縏oolbar1到Panel2上。為了避免這種混亂，我們可以調整Source對象的DockRect以修改?？烤匦蔚娘@示，下面是調整矩形的代碼：
procedure TForm1.Panel2DockOver(Sender: TObject; Source: TDragDockObject;
X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
Accept := (Source.Control.Name = 'ToolBar2');
if not Accept then
Source.DockRect := AdjustDockRect(Sender, Source, X, Y);
end;

function TForm1.AdjustDockRect(Sender: TObject; Source: TDragDockObject; X, Y:Integer): TRect;
var
ARect: TRect;
begin
//將當前鼠標位置換算成屏幕坐標，賦值給矩形左上角
ARect.TopLeft := (Sender as TWinControl).ClientToScreen(Point(X, Y));
//根據被拖放的工具條的尺寸計算出右下角坐標
ARect.BottomRight := TWinControl(Sender).ClientToScreen(
Point(X + Source.Control.Width, Y + Source.Control.Height));
//最后根據鼠標拖動組件的部位計算出實際的矩形X,Y方向上的位移
OffsetRect(ARect,
-Trunc(Source.Control.Width * Source.MouseDeltaX),
-Trunc(Source.Control.Height * Source.MouseDeltaY));
Result:=ARect;
end;
上面的代碼過于煩瑣，有沒有更簡單的辦法呢？VCL會在DockOver事件前調用OnGetSiteInfo事件獲得被?？拷M件的信息，
同時返回一個CanDock參數表示是否接受?？拷M件的停靠，事件定義如下：

type TGetSiteInfoEvent = procedure(Sender: TObject; DockClient: TControl; var InfluenceRect: TRect;
MousePos: TPoint; var CanDock: Boolean) of object;

如果CanDock為False，則后面的DockOver就不會被調用了，也就無須修改工具條?？烤匦瘟?。我們需要就是判斷DockClient
的名稱，決定是否允許拖放，代碼如下：

procedure TForm1.Panel1GetSiteInfo(Sender: TObject; DockClient: TControl;

var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
begin
CanDock:=DockClient.Name='ToolBar1';
end;

procedure TForm1.Panel2GetSiteInfo(Sender: TObject; DockClient: TControl;
var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
begin
CanDock:=DockClient.Name='ToolBar2';
end;

可以看到這種方式要比前一種方式簡潔得多。

手工停靠

前面我們介紹的主要是通過鼠標的拖放動作來實現的組件的?？?#xff0c;VCL還提供了ManualDock和ManualFloat過程來實現手工
Dock和UnDock的功能，將前面的簡單停靠中切換工具條是否顯示的菜單命令修改如下：

procedure TForm1.ActionViewToolBarUpdate(Sender: TObject);
begin
if (Toolbar1.Visible and not Toolbar1.Floating)then
(Sender as TAction).Caption:='UnDock'
else
(Sender as TAction).Caption:='Dock';
end;

procedure TForm1.ActionViewToolBarExecute(Sender: TObject);
begin
if (Sender as TAction).Caption='Dock' then
begin
Toolbar1.ManualDock(Form1, nil, alTop);
//如果Dock的目標是窗體，必須加上下面兩句話，如果是其它控件則不需要，這是VCL中//的一個bug
Toolbar1.Align:=alTop;
Toolbar1.Visible:=True;
end
else
Toolbar1.ManualFloat(Rect(Left, Top, Left + ToolBar1.UndockWidth, Top + ToolBar1.UndockHeight));
end;

當Toolbar1的Floating屬性為True時，表示它正處于浮動狀態，我們可以進行?？坎僮?#xff0c;反之則進行UnDock操作，使用
ManualDock時，需要指定?？磕繕藶镕orm1，對齊方式為alTop，注意至少在Delphi7中，將工具條手工?？康酱绑w有問題
，無法看到正確的結果，必須在重新設定一下Visible和Align屬性，但是如果?？磕繕耸敲姘宓绕渌丶?#xff0c;則沒有問題，
這應該是VCL中的bug。而使用ManualFloat使控件處于浮動狀態時，需要指定浮動區域的矩形位置和大小，矩形的寬和高
對應于工具條的UndockWidth和UndockHeight屬性。

管理停靠區域

凡是用過Word的人都知道，Word中的工具條的?？磕芰Ψ浅?#xff0c;不僅可以停靠在文字編輯器的頂部，還可以?？吭谧筮?#xff0c;
右邊和下邊，那么我們如果用VCL來模擬這一動作呢？一個比較簡單的辦法是在窗體的上下左右放上四個TPanel，設定它
們的DockSite屬性為True就可以了，下面是新建一個項目，然后按下圖示意添加面板：

面板的屬性設置如下：

object PanelTop: TPanel

…

Align = alTop

DockSite = True

end

object PanelLeft: TPanel

…

Align = alLeft

DockSite = True

end

object PanelRight: TPanel

…

Align = alRight

DockSite = True

end

object PanelBottom: TPanel

…

Align = alBottom

DockSite = True

end

object PanelMain: TPanel

…

Align = alClient

end

放上一個工具條，設定工具條DragKind屬性為dkDock，實現Toolbar1的OnMouseDown事件如下：

procedure TForm1.ToolBar1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Toolbar1.BeginDrag(False);
end;

運行程序，可以看到工具條確實可以在窗體的四周?？?#xff0c;但是工具條始終是水平排布的，在?？康阶筮厱r變成垂
直排布，所以我們要在拖放完成時，修改工具條的align屬性，當組件在被停靠面板上釋放時，會調用面板的OnDragDrop
事件，我們可以在該事件中修改工具條的屬性。

新的問題又產生了，Word的?？吭谏舷伦笥叶紱]有明顯可見的?？磕繕丝丶?#xff0c;而我們則使用了四個很明顯的面板，為此要
修改面板的AutoSize屬性為True，這樣當沒有控件在面板上時，將面板的寬或高調整為0，這樣運行時，用戶就看不到面
板了，同時雖然面板的尺寸變小了，但是VCL響應拖放的矩形區域其實是真實面板的尺寸在各個方向上都加上10個像素，所
以面板仍然能夠響應工具條的拖放動作。再次運行程序，會發現程序運行的效果這回和Word幾乎一模一樣了。

但是，有點美中不足的是，由于面板在沒有工具條時自動調整面板的大小，設定寬或高為0，這是顯示的工具條的停靠矩形
跟縮小的面板尺寸進行匹配后畫出來的就是一個非常狹長的矩形，視覺效果不佳。因為VCL是在?？抗ぞ邨l在被?？棵姘迳?br />移動時畫停靠矩形的，所以我們可以像前面那樣在面板的OnDockOver事件中對DockRect進行處理，擴大矩形區域：

procedure TForm1.PanelLeftDockOver(Sender: TObject;
Source: TDragDockObject; X, Y: Integer; State: TDragState;
var Accept: Boolean);
var
DockBar: TToolBar;
InflateSize: Integer;
ARect: TRect;
ClientTL: TPoint;
begin
DockBar := Source.Control as TToolBar;
//如果處于水平狀態，獲得工具條的高度，如果處于垂直狀態，獲得工具條的寬度
if DockBar.Width > DockBar.Height then
InflateSize := DockBar.Height
else
InflateSize := DockBar.Width;
//將停靠矩形調整為工具條的尺寸
ARect := Source.DockRect;
case (Sender as TPanel).Align of
alTop: Inc(ARect.Bottom, InflateSize);
alLeft: Inc(ARect.Left, InflateSize);
alBottom: Dec(ARect.Top, InflateSize);
alRight: Dec(ARect.Right, InflateSize);
end;
//由于界面布局的問題，必然有兩個方向上的面板的矩形
//比窗體的實際尺寸要小,因為設計時，四個面板的尺寸
//不能完全占有占據整個窗體的垂直和水平方向
//所以接下來就是調整矩形區域，使其看起來好像是占據了整個窗體
ClientTL := Point(0, 0);
ClientTL := ClientToScreen(ClientTL);
case (Sender as TPanel).Align of
alTop, alBottom:
begin
//使水平方向的矩形的寬度等于窗體的寬度
ARect.Left := ClientTL.X;
ARect.Right := ClientTL.X + ClientWidth;
end;
alLeft, alRight:
begin
//使垂直方向的矩形的高度等于窗體的高度
ARect.Top := ClientTL.Y;
ARect.Bottom := ClientTL.Y + ClientHeight;
end;
end;
Source.DockRect := ARect
end;
調整前的效果：

調整后的效果：

?

分頁停靠

在本文的第一個示意圖上可以看到Delphi的IDE中除了普通的停靠組件排列外，還支持將各個窗口停靠在TPageControl
組件上，分頁停靠，Code Explorer和BreakPoint List窗口同普通的?？坎灰粯?#xff0c;每當一個窗口?？窟MCodeExplorer窗
口時，都會在TPageControl組件上新增一個頁面，并將新的窗口停靠在頁面上，實現子窗口的分頁瀏覽。

要想實現這一功能非常簡單，因為VCL的TPageControl組件重載了TWinControl組件的DoAddDockClient和DoRemoveDockClient
方法，能夠自動響應停靠動作添加新的頁面，而當浮動被?？康拇翱诤髮⒆詣拥膶⑾惹皠摻ǖ腡TabSheet頁面刪除，我們無須
寫一行代碼，只要設定基本的屬性就可以實現分頁停靠的功能。

新建一個項目，向窗體上放置一個TPageControl，設定DockSite屬性為True。然后創建一個新的窗體，命名為TFormChild，
設定窗體的DragKind屬性為dkDock，同樣的，編寫子窗體的OnMouseDown事件，通過BeginDrag方法發起?？?。然后再在主
窗體上添加一個菜單項，用來新建子窗體：

var
I:Integer;
procedure TForm1.N1Click(Sender: TObject);
var
AForm:TFormChild;
begin
AForm:=TFormChild.Create(Application);
AForm.Caption:='ChildForm'+IntToStr(I);
Inc(I);
AForm.Show;
end;

運行程序，創建新的窗體，然后將窗體?？康絋PageControl上，可以看到每?？恳粋€新的窗體，PageControl就會新建一個
頁面，每浮動一個窗體，就會刪除先前的頁面。示意圖如下：

?

定制拖放圖像

同拖放操作中類似，在停靠/浮動操作過程中，VCL也會創建一個TDragDockObject對象的實例，用來在?？繉ο蠛屯？磕繕?br />之間傳遞信息。我們可以在OnStartDock事件中提供一個自定義的停靠對象，進而可以對停靠過程進行更為靈活的控制。停
靠對象基類TDragDockObject的類型定義如下：

TDragDockObject = class(TBaseDragControlObject)
…
protected
procedure AdjustDockRect(ARect: TRect); virtual;
procedure DrawDragDockImage; virtual;
procedure EndDrag(Target: TObject; X, Y: Integer); override;
procedure EraseDragDockImage; virtual;
function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
function GetFrameWidth: Integer; virtual;
public
…
property Brush: TBrush read FBrush write SetBrush;
property DockRect: TRect read FDockRect write FDockRect;
property DropAlign: TAlign read FDropAlign;
property DropOnControl: TControl read FDropOnControl;
property Floating: Boolean read FFloating write FFloating;
property FrameWidth: Integer read GetFrameWidth;
end;

其中比較重要的可以重載的方法有GetDragCursor，VCL在做?？坎僮鲿r默認情況是不顯示任何的拖放光標，而我們可以在停
靠過程中根據被?？拷M件是否接受?？拷M件來顯示不同的拖放光標。下面舉例說明，新建一個項目，在窗體上添加兩個
TShape組件，一個TPanel，屬性設置如下：

object Shape1: TShape

…

DragKind = dkDock

DragMode = dmAutomatic

end

object Shape2: TShape

…

DragKind = dkDock

DragMode = dmAutomatic

Shape = stEllipse

end

object Panel1: TPanel

…

Align = alRight

DockSite = True

End

object Panel2: TPanel

…

Align = alLeft

DockSite = True

end

定義一個新的TDockShapeObj的?？款?#xff0c;類定義如下：

TDockShapeObj=class(TDragDockObjectEx)
protected
function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
end;

注意，這里我們是從TDragDockObjectEx的基類派生出我們的自定義類，TDragDockObjectEx是從Delphi6開始引入到VCL的，
特點就是VCL會在停靠完成后自動釋放它，無須手工釋放。TDockShapeObj重載了GetDragCurosr方法，在?？磕繕私邮芡？?br />組件時時顯示光標，而在?？磕繕瞬唤邮芡戏艜r顯示光標。代碼如下：

function TDockShapeObj.GetDragCursor(Accepted: Boolean; X,
Y: Integer): TCursor;
begin
if Accepted then
result:=crDrag
else
result:=crNo;
end;

為了比較兩者的區別，我們讓Panel2不接受任何的拖放：

procedure TForm1.Panel2DockOver(Sender: TObject; Source: TDragDockObject;
X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
Accept:=False;
end;

運行程序，可以看到當將Shape1拖放到Panel1是顯示的crDrag光標，而拖放到Panel2上時則顯示crNo光標表示不接受停靠。

?

接下來我們看TDragDockObject還有另外兩個重要的方法DrawDragDockImage和EraseDragDockImage，VCL在拖放時不停的調
用這兩個方法在屏幕上畫停靠圖像和擦去?？繄D像，默認的停靠圖像總是一個灰色矩形方框，不是很美觀，因此我們可以重
載這兩個方法來實現自定義的?？繄D像，比如對于Shape組件，我們想當Shape類型為圓形時，?？繄D像也為圓形。下面就是
重載后的DrawDragDockImage和EraseDragDockImage方法：

procedure TDockShapeObj.DrawDragDockImage;
begin
if (Control is TShape) and (TShape(Control).Shape = stEllipse) then
ShapeDockImage(False)
else
inherited;
end;

procedure TDockShapeObj.EraseDragDockImage;
begin
if (Control is TShape) and (TShape(Control).Shape = stEllipse) then
ShapeDockImage(True)
else
inherited;
end;

procedure TDockShapeObj.ShapeDockImage(Erase: Boolean);
var
DesktopWindow: HWND;
DC: HDC;
OldBrush: HBrush;
DrawRect: TRect;
OldBitmap: HBITMAP;
begin
DesktopWindow := GetDesktopWindow;
DC := GetDCEx(DesktopWindow, 0, DCX_CACHE or DCX_LOCKWINDOWUPDATE);
try
if Erase then
begin
DrawRect := FEraseDockRect;
//恢復保存的背景
BitBlt(DC, DrawRect.Left, DrawRect.Top, DrawRect.Right -
DrawRect.Left, DrawRect.Bottom - DrawRect.Top, THackPanel(Form1.Panel3).Canvas.Handle, 0, 0,
SRCCOPY);
end
else
begin
DrawRect := DockRect;
FEraseDockRect := DockRect;
//保存當前的矩形的背景
BitBlt(THackPanel(Form1.Panel3).Canvas.Handle,0, 0, DrawRect.Right - DrawRect.Left, DrawRect.Bottom - DrawRect.Top, DC, DrawRect.Left, DrawRect.Top, SRCCOPY);
//畫橢圓
OldBrush := SelectObject(DC, (Self.Control as TShape).Brush.Handle);
Windows.Ellipse(DC, DrawRect.Left, DrawRect.Top, DrawRect.Right, DrawRect.Bottom);
SelectObject(DC, OldBrush);
end;
finally
ReleaseDC(DesktopWindow, DC);
end;
end;

其中畫圖的原理就是先將要畫圖的矩形區域的位圖保存起來，然后畫橢圓，在擦除橢圓時，只要將原來保存的背景將現在的
背景覆蓋一下就可以了。

定制浮動窗口

當我們雙擊Word中的被拖放出來的浮動的窗口的標題欄時，Word會自動將浮動的窗口?？炕卦瓉淼奈恢?#xff0c;這是一項很方便的
功能，可是VCL默認生成的浮動窗口卻沒有這項功能，需要我們自己來實現。

VCL中默認的浮動窗口是TCustomDockForm，它的類定義如下：

TCustomDockForm = class(TCustomForm)
…
protected
procedure DoAddDockClient(Client: TControl; const ARect: TRect); override;
procedure DoRemoveDockClient(Client: TControl); override;
procedure GetSiteInfo(Client: TControl; var InfluenceRect: TRect;
MousePos: TPoint; var CanDock: Boolean); override;
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
…
end;

要想實現停靠回原來的?？垮^點，我們要做的首先是重載DoAddClient方法，在添加停靠組件時，記錄原來的?？课恢?。
其次，我們要截獲WM_NCLBUTTONDBLCLK消息響應標題欄雙擊事件。新的TOfficeDockForm實現如下：

TOfficeDockForm=class(TCustomDockForm)
private
FOldSite:TWinControl;
protected
procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
procedure DoAddDockClient(Client: TControl; const ARect: TRect); override;
procedure NCDblClick(var Msg: TWMNCLButtonDBLCLK);message WM_NCLBUTTONDBLCLK ;
end;
…

procedure TOfficeDockForm.DoAddDockClient(Client: TControl;
const ARect: TRect);
begin
FOldSite:=TWinControl(Client.Tag);
inherited;
end;

procedure TOfficeDockForm.NCDblClick(var Msg: TWMNCLButtonDBLCLK);
begin
if Msg.HitTest=htCaption then
DockClients[0].ManualDock(FOldSite);
end;

procedure TOfficeDockForm.WMNCLButtonDown(var Message: TWMNCLButtonDown);
begin
//inherited;
DefaultHandler(message);
end;

上面代碼中有幾點要說明的是在DoAddClient方法中，我們是將添加的控件的Tag屬性映射為它的前一個?？垮^點，前提是
因為VCL在停靠過程中并不保存原有被?？拷M件的信息，所以在使用新的TOfficeDockForm前，我們必須在?？拷M件的
OnStartDock時，手工將被停靠組件的信息綁定到?？拷M件的Tag屬性上。

另外，我們除了截獲了窗口非客戶區鼠標雙擊事件外，還截獲了非客戶區的鼠標單擊事件，這是因為TCustomDockForm截獲了
鼠標單擊事件，做了如下處理：

procedure TCustomDockForm.WMNCLButtonDown(var Message: TWMNCLButtonDown);
begin
if (Message.HitTest = HTCAPTION) and (DragKind <> dkDock) and not
(csDesigning in ComponentState) and not IsIconic(Handle) and
(DockClientCount > 0) then
begin
{ Activate window since we override WM_NCLBUTTON behavior }
SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or SWP_NOMOVE or
SWP_NOSIZE);
PostMessage(Handle, WM_NCLBUTTONUP, TMessage(Message).WParam,
TMessage(Message).LParam);
//如果客戶單擊窗口標題欄，則發起?？?br /> if Active then DockClients[0].BeginDrag(True);
end
else
inherited;
end;

問題是默認的處理是一旦客戶單擊了浮動窗口的標題欄，就發起?？縿幼?#xff0c;但是發起?？亢笫髽穗p擊標題欄事件就不會被
觸發了。所以，我們在TOfficeDockForm中沒有調用繼承的TCustomDockForm的相應處理，而是調用DefaultHandler過程，
使用默認的消息處理方法來處理。

剩下的工作就是新建一個項目，在窗體上放上一個Button和兩個面板，Button可以?？吭趦蓚€面板上，在窗體創建時，
將TOfficeDockForm的類類型賦值給Button的FloatingDockSiteClass屬性，這樣Button在創建浮動窗口時會自動使用我們的
TOfficeDockForm了：

procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.ManualDock(Panel2);
Button1.FloatingDockSiteClass:=TOfficeDockForm;
end;
另外在每次停靠前，Button都要在OnStartDock事件中記錄原來的停靠錨點的屬性，以便TOfficeDockForm能夠獲得原來的停
靠位置信息。

procedure TForm1.Button1StartDock(Sender: TObject;
var DragObject: TDragDockObject);
begin
Button1.Tag:=Integer(Button1.Parent);
end;

?？抗芾砥?/p>

在上面的例子中，可以注意到，當Button停靠到面板上時，會出現一個和Delphi的IDE完全一樣的停靠窗體，上面是兩條橫線，可以用來把Button拖出來(一般成為拖放把手)，右上角有一個小X是個關閉按鈕，可以關閉Button，同時?？扛嗟腂utton時，它們會自動進行水平或者垂直排列。見下面示意圖：

但是，我們使用窗體作為?？垮^點時卻不會出現拖放把手和關閉按鈕，而且停靠多個組件時，也不會自動排列，而是隨意排列，見下面的示意代碼：
…
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
…
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
const
Colors: array[1..6] of TColor =
(clWhite, clBlack, clBlue, clGreen, clRed, clYellow);
var
I: Integer;
begin
for I := Low(Colors) to High(Colors) do
with TForm.CreateNew(Self) do
begin
Caption := '停靠到主窗體';
Color := Colors[I];
DragKind := dkDock;
DragMode := dmAutomatic;
Position := poDefaultPosOnly;
Width := 230;
Height := 100;
Visible := True;
end;
end;

end.

在窗體的OnCreate事件中，我們創建了不同顏色的窗體，這些窗體可以被拖放進主窗體，拖放后效果如下：

那么為什么窗體的?？啃Ч兔姘宓牟灰粯幽?#xff1f;接下來做個試驗，將窗體的UseDockManager的屬性設定為True，再次運行程序，進行停靠，你會發現這回面板的停靠效果是一樣的了。

打開Delphi的幫助，看一下UseDockManager屬性的說明，可以知道當UseDockManager為True時，VCL使用一個?？抗芾砥?br />來管理?？康膭幼?#xff0c;?？抗芾砥鲿幚硗？拷M件的排列關系以及繪畫?？堪咽趾完P閉按鈕等等操作。VCL中內置了一個
TDockTree的類實現了?？抗芾砥鞯慕涌?#xff0c;提供了默認的停靠管理的實現，但是這個TDockTree有一點問題就是當管理多
個?？拷M件時，它繪畫?？繀^域時經常會造成畫面混亂，Delphi 4，5的IDE因為使用了TDockTree作為?？抗芾砥?#xff0c;導致
停靠工具條時，屏幕經常亂閃一氣，工具條也經常會找不到，相信很多人都有過和我同樣的不愉快經歷，到了Delphi 6
、7之后，繪畫混亂的情況有所好轉，但是還是會有問題。那么一個簡單的解決方案是在完成?？亢?#xff0c;調用DockManager
的ResetBounds方法重新計算?？拷M件布局排列并重新繪制?？繀^域：

procedure TForm1.FormDockDrop(Sender: TObject; Source: TDragDockObject; X,
Y: Integer);
begin
DockManager.ResetBounds(True);
end;

美化?？繀^域繪畫

使用默認的停靠管理器可以很容易的實現高級的?？啃Ч?#xff0c;但是千人一面的效果用多了，難免讓人厭倦，這也就是我猜為什么微軟每出一個新版Office的時候，都要把界面重新打造一遍的原因。對于默認的?？抗芾砥鱽碚f，我個人不喜歡兩條橫線樣式的?？堪咽?#xff0c;希望是一條橫線，同時希望在橫線的旁邊還能顯示窗口的標題，要想實現自定義的?？堪咽?#xff0c;我們就需要提供一個自定義的?？抗芾砥鱽斫庸芡？繀^域的繪制工作。先來看默認?？抗芾砥鱐DockTree的類定義：

TDockTree = class(TInterfacedObject, IDockManager)
…
protected
procedure AdjustDockRect(Control: TControl; var ARect: TRect); virtual;
…
procedure PaintDockFrame(Canvas: TCanvas; Control: TControl;
const ARect: TRect); virtual;
…
end;
其中在繪制?？堪咽诌^程中TDockTree會調用AdjustDockRect來調整?？繀^域的大小為把手和關閉按鈕騰出繪制的空間來，而PaintDockFrame則被用來繪制具體的橫線和把手。由于默認的TDockTree留出的把手區域太窄，畫出的字體不好看，所以我們要重載AdjustDockRect方法擴大把手區域。而要實現繪制自定義的單條橫線和標題，我們還需要重載PaintDockFrame方法，下面是我們的新的?？抗芾砥鞯拇a：

TNewDockManager = class(TDockTree)
protected
procedure PaintDockFrame(Canvas: TCanvas; Control: TControl;
const ARect: TRect); override;
procedure AdjustDockRect(Control: TControl; var ARect: TRect); override;
end;

THackControl = class(TControl);
…
const
GrabberSize = 20;//把手大小，這里定得大一些，為了使標題畫出來好看些

procedure TNewDockManager.AdjustDockRect(Control: TControl;
var ARect: TRect);
begin
if DockSite.Align in [alTop, alBottom] then
inc(ARect.Left, GrabberSize) else
inc(ARect.Top, GrabberSize);
end;

procedure TNewDockManager.PaintDockFrame(Canvas: TCanvas;
Control: TControl; const ARect: TRect);
procedure DrawCloseButton(Left, Top: Integer);
begin
DrawFrameControl(Canvas.Handle, Rect(Left, Top, Left+GrabberSize-2,
Top+GrabberSize-2), DFC_CAPTION, DFCS_CAPTIONCLOSE);
end;

procedure DrawCaptionBar(Left, Top, Right, Bottom: Integer);
begin
Canvas.Brush.Color := clActiveCaption;
Canvas.FillRect(Rect(Left, Top, Right, Bottom));
end;

procedure DrawCaptionText(const Text: String; Left, Top, Right, Bottom: Integer);
begin
Canvas.Font.Name := '??ì?';
Canvas.Font.Color := clCaptionText;
Canvas.Font.Height := Succ(Top - Bottom);
Canvas.TextRect(Rect(Left, Top, Right, Bottom), Left, Top, Text);
end;

procedure DrawGrabberLine(Left, Top, Right, Bottom: Integer);
begin
with Canvas do
begin
Pen.Color := clBtnHighlight;
MoveTo(Right, Top);
LineTo(Left, Top);
LineTo(Left, Bottom);
Pen.Color := clBtnShadow;
LineTo(Right, Bottom);
LineTo(Right, Top-1);
end;
end;

begin
with ARect do
if DockSite.Align in [alTop, alBottom] then
begin
DrawCaptionBar(Left, Top, Left+GrabberSize-1, Bottom);
//畫橫線
DrawGrabberLine(Left+4, Top+GrabberSize+1, Left+6, Bottom-2);
DrawCloseButton(Left+1, Top+1);
end
else
begin
DrawCaptionBar(Left, Top, Right, Top+GrabberSize-1);
//畫標題
DrawCaptionText(THackControl(Control).Caption,
Left, Top, Right, Top+GrabberSize-2);
DrawGrabberLine(Left+Canvas.TextWidth(THackControl(Control).Caption)+4, Top+7, Right-GrabberSize-2, Top+9);
DrawCloseButton(Right-GrabberSize+2, Top+1);
end;
end;

上面AdjustDockRect方法主要是根據窗口的對齊方式按不同方向擴大停靠區域大小，省出標題欄的空間來，這里我們留出的把手大小為20，比較大，主要是為了畫出的標題好看一些。至于繪制把手和關閉按鈕，很多代碼是從TDockTree的原代碼中復制過來的，除了增加了畫標題文本和只畫一條橫線的處理外，其余的大同小異。

光有新的?？抗芾砥鬟€不夠，我們還需要讓?？看绑w使用這個?？抗芾砥?#xff0c;因此要重載窗體的CreateDockManager方法來提供我們定制的DockManager。

function TForm1.CreateDockManager: IDockManager;
begin
//創建新的DockManager的實例
if (DockManager = nil) and DockSite and UseDockManager then
Result := TNewDockManager.Create(Self)
else
Result := DockManager;
//設定雙緩沖以減少屏幕閃爍
DoubleBuffered := DoubleBuffered or Assigned(Result);
end;

運行程序，欣賞一下我與眾不同的審美眼光吧：

總結

總的來說，Borland提供的停靠功能是非常強大，而且很容易擴展，一點不足就是默認的?？抗芾砥饔幸恍〣ug，同時界面繪制略顯單調了一些，相關文檔也比較少。希望通過這篇文章的介紹，大家可以以此為起點寫出更為專業的?？拷缑?#xff0c;秀出真我的色彩來。

轉載于:https://www.cnblogs.com/spiritofcloud/p/3976171.html

總結

以上是生活随笔為你收集整理的高级停靠(Dock)技术的实现的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。