高级停靠(Dock)技术的实现
所謂停靠就是可以用鼠標拖動窗體或者控件，并將其從一個父窗體移出或者移動到另一個父窗體上，可以按水平，垂直方
向整齊排列， 并且可以停靠在分頁控制組件上。下面的示意圖是一個Delphi IDE的窗口停靠示意圖：
考察一些常用的軟件如Office等大型軟件，會發現大多提供窗體停靠的功能。微軟的MFC很早就引入了工具條的拖放功能，
可以將工具條上窗口上邊拖放到窗口下邊。而Borland則最早在Delphi 4中開始引入停靠功能支持，它實際上就是基于前
面我們講到的VCL拖放技術基礎之上的，后面我們會看到兩者有多么的類似。Borland提供了停靠功能的一個演示程序，
可以在..\Demos\Docking目錄下找到它，不過這個例子的問題就是太過復雜，使用了很多的高級技巧，不易理解。所以我
將拋開復雜的示例，一步一步的揭開停靠的秘密。
一個簡單的停靠實現
工具條的停靠功能是最常見的功能需求，新建一個程序，在窗體上放置一個工具條，然后任意添加幾個按鈕，為了讓工具條
能夠從窗體上移出，最簡單的辦法是設定工具條的DragMode屬性為dmAutomatic，將DragKind屬性設定為dkDock。就像在拖
放類一章我們說的，DragMode設定為dmAutomatic表示當鼠標在工具條上點擊并移動后，會自動發起拖放動作。而DragKind
為dkDock表示接下來的操作是一個停靠操作而不是普通的拖放操作。
運行這個簡單的程序，然后拖放工具條，我們發現確實可以將工具條拖離主窗體使其變成一個浮動的工具條。注意在工具條
從窗體拖離時，VCL會在屏幕上畫一個矩形表示工具條，我們稱其為停靠圖像。見下圖：
?
可以看到，VCL強大的停靠支持使我們不用寫一行代碼就可以實現簡單的停靠功能了，但是上面的程序存在幾個問題：
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;
再次運行修改后的停靠程序，多拖放停靠幾次后，我們又會發現一個新的問題，那就是雖然浮動工具條可以被停靠回主界面
，但是位置不再是同界面頂部對齊，而是可以停靠在任意位置上，這顯然不是我們想要的效果，什么原因造成的呢？怎么解
決呢？
原來，VCL在拖離任何控件后，都會將控件的Align屬性修改為alNone，要想解決這個問題，就需要在工具條停靠在窗體上之
后將工具條的Align屬性重新設定為alTop。幸好同拖放操作一樣，在停靠組件時，VCL同樣會產生一系列的事件，其中 OnEndDock事件會在停靠完成后發生，正好滿足我們的需要，實現的工具條的OnEndDock事件如下：
procedure TForm1.ToolBar1EndDock(Sender, Target: TObject; X, Y: Integer);
begin
Toolbar1.Align:=alTop;
end;
復雜界面的停靠
上面的停靠功能可以滿足簡單界面的需求了，那么考慮一個復雜的界面停靠操作。假設你的項目經理要求你在主界面上放置
兩個面板，上面的面板上有一個工具條，下面的面板上也有一個工具條。兩個面板上的工具條都停靠操作，但是有一個要求
是上面面板的工具條只能停靠在上面的面板上，同樣下面的工具條也只能停靠在下面的面板上。
當組件在要停靠的組件上被拖動時，會調用被停靠組件的OnDockOver事件， OnDockOver的事件定義如下；
type TDockOverEvent = procedure(Sender: TObject; Source:
TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean) of object;
其中Source是一個VCL在停靠操作中自動創建的TDragDockObject類型的對象，它的Control屬性就是停靠組件，所以可以在組件的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的停靠矩形為Panel1的形狀，在實際使用中可能會讓用戶產生一種錯覺，以為可以停靠Toolbar1到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事件獲得被停靠組件的信息，
同時返回一個CanDock參數表示是否接受停靠組件的停靠，事件定義如下：
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;
可以看到這種方式要比前一種方式簡潔得多。
手工停靠
前面我們介紹的主要是通過鼠標的拖放動作來實現的組件的停靠，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時，表示它正處于浮動狀態，我們可以進行停靠操作，反之則進行UnDock操作，使用
ManualDock時，需要指定停靠目標為Form1，對齊方式為alTop，注意至少在Delphi7中，將工具條手工停靠到窗體有問題
，無法看到正確的結果，必須在重新設定一下Visible和Align屬性，但是如果停靠目標是面板等其它控件，則沒有問題，
這應該是VCL中的bug。而使用ManualFloat使控件處于浮動狀態時，需要指定浮動區域的矩形位置和大小，矩形的寬和高
對應于工具條的UndockWidth和UndockHeight屬性。
管理停靠區域
凡是用過Word的人都知道，Word中的工具條的停靠能力非常強，不僅可以停靠在文字編輯器的頂部，還可以停靠在左邊，
右邊和下邊，那么我們如果用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;
運行程序，可以看到工具條確實可以在窗體的四周停靠，但是工具條始終是水平排布的，在停靠到左邊時變成垂
直排布，所以我們要在拖放完成時，修改工具條的align屬性，當組件在被停靠面板上釋放時，會調用面板的OnDragDrop
事件，我們可以在該事件中修改工具條的屬性。
新的問題又產生了，Word的停靠在上下左右都沒有明顯可見的停靠目標控件，而我們則使用了四個很明顯的面板，為此要
修改面板的AutoSize屬性為True，這樣當沒有控件在面板上時，將面板的寬或高調整為0，這樣運行時，用戶就看不到面
板了，同時雖然面板的尺寸變小了，但是VCL響應拖放的矩形區域其實是真實面板的尺寸在各個方向上都加上10個像素，所
以面板仍然能夠響應工具條的拖放動作。再次運行程序，會發現程序運行的效果這回和Word幾乎一模一樣了。
但是，有點美中不足的是，由于面板在沒有工具條時自動調整面板的大小，設定寬或高為0，這是顯示的工具條的停靠矩形
跟縮小的面板尺寸進行匹配后畫出來的就是一個非常狹長的矩形，視覺效果不佳。因為VCL是在停靠工具條在被停靠面板上
移動時畫停靠矩形的，所以我們可以像前面那樣在面板的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窗口同普通的停靠不一樣，每當一個窗口停靠進CodeExplorer窗
口時，都會在TPageControl組件上新增一個頁面，并將新的窗口停靠在頁面上，實現子窗口的分頁瀏覽。
要想實現這一功能非常簡單，因為VCL的TPageControl組件重載了TWinControl組件的DoAddDockClient和DoRemoveDockClient
方法，能夠自動響應停靠動作添加新的頁面，而當浮動被停靠的窗口后將自動的將先前創建的TTabSheet頁面刪除，我們無須
寫一行代碼，只要設定基本的屬性就可以實現分頁停靠的功能。
新建一個項目，向窗體上放置一個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;
運行程序，創建新的窗體，然后將窗體停靠到TPageControl上，可以看到每停靠一個新的窗體，PageControl就會新建一個
頁面，每浮動一個窗體，就會刪除先前的頁面。示意圖如下：
?
定制拖放圖像
同拖放操作中類似，在停靠/浮動操作過程中，VCL也會創建一個TDragDockObject對象的實例，用來在停靠對象和停靠目標
之間傳遞信息。我們可以在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在做停靠操作時默認情況是不顯示任何的拖放光標，而我們可以在停
靠過程中根據被停靠組件是否接受停靠組件來顯示不同的拖放光標。下面舉例說明，新建一個項目，在窗體上添加兩個
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的停靠類，類定義如下：
TDockShapeObj=class(TDragDockObjectEx)
protected
function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
end;
注意，這里我們是從TDragDockObjectEx的基類派生出我們的自定義類，TDragDockObjectEx是從Delphi6開始引入到VCL的，
特點就是VCL會在停靠完成后自動釋放它，無須手工釋放。TDockShapeObj重載了GetDragCurosr方法，在停靠目標接受停靠
組件時時顯示光標，而在停靠目標不接受拖放時顯示光標。代碼如下：
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在拖放時不停的調
用這兩個方法在屏幕上畫停靠圖像和擦去停靠圖像，默認的停靠圖像總是一個灰色矩形方框，不是很美觀，因此我們可以重
載這兩個方法來實現自定義的停靠圖像，比如對于Shape組件，我們想當Shape類型為圓形時，停靠圖像也為圓形。下面就是
重載后的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會自動將浮動的窗口停靠回原來的位置，這是一項很方便的
功能，可是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在停靠過程中并不保存原有被停靠組件的信息，所以在使用新的TOfficeDockForm前，我們必須在停靠組件的
OnStartDock時，手工將被停靠組件的信息綁定到停靠組件的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);
//如果客戶單擊窗口標題欄，則發起停靠
if Active then DockClients[0].BeginDrag(True);
end
else
inherited;
end;
問題是默認的處理是一旦客戶單擊了浮動窗口的標題欄，就發起停靠動作，但是發起停靠后鼠標雙擊標題欄事件就不會被
觸發了。所以，我們在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;
停靠管理器
在上面的例子中，可以注意到，當Button停靠到面板上時，會出現一個和Delphi的IDE完全一樣的停靠窗體，上面是兩條橫線，可以用來把Button拖出來(一般成為拖放把手)，右上角有一個小X是個關閉按鈕，可以關閉Button，同時停靠更多的Button時，它們會自動進行水平或者垂直排列。見下面示意圖：
但是，我們使用窗體作為停靠錨點時卻不會出現拖放把手和關閉按鈕，而且停靠多個組件時，也不會自動排列，而是隨意排列，見下面的示意代碼：
…
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事件中，我們創建了不同顏色的窗體，這些窗體可以被拖放進主窗體，拖放后效果如下：
那么為什么窗體的停靠效果和面板的不一樣呢？接下來做個試驗，將窗體的UseDockManager的屬性設定為True，再次運行程序，進行停靠，你會發現這回面板的停靠效果是一樣的了。
打開Delphi的幫助，看一下UseDockManager屬性的說明，可以知道當UseDockManager為True時，VCL使用一個停靠管理器
來管理停靠的動作，停靠管理器會處理停靠組件的排列關系以及繪畫停靠把手和關閉按鈕等等操作。VCL中內置了一個
TDockTree的類實現了停靠管理器的接口，提供了默認的停靠管理的實現，但是這個TDockTree有一點問題就是當管理多
個停靠組件時，它繪畫停靠區域時經常會造成畫面混亂，Delphi 4，5的IDE因為使用了TDockTree作為停靠管理器，導致
停靠工具條時，屏幕經常亂閃一氣，工具條也經常會找不到，相信很多人都有過和我同樣的不愉快經歷，到了Delphi 6
、7之后，繪畫混亂的情況有所好轉，但是還是會有問題。那么一個簡單的解決方案是在完成停靠后，調用DockManager
的ResetBounds方法重新計算停靠組件布局排列并重新繪制停靠區域：
procedure TForm1.FormDockDrop(Sender: TObject; Source: TDragDockObject; X,
Y: Integer);
begin
DockManager.ResetBounds(True);
end;
美化停靠區域繪畫
使用默認的停靠管理器可以很容易的實現高級的停靠效果，但是千人一面的效果用多了，難免讓人厭倦，這也就是我猜為什么微軟每出一個新版Office的時候，都要把界面重新打造一遍的原因。對于默認的停靠管理器來說，我個人不喜歡兩條橫線樣式的停靠把手，希望是一條橫線，同時希望在橫線的旁邊還能顯示窗口的標題，要想實現自定義的停靠把手，我們就需要提供一個自定義的停靠管理器來接管停靠區域的繪制工作。先來看默認停靠管理器TDockTree的類定義：
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方法，下面是我們的新的停靠管理器的代碼：
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的原代碼中復制過來的，除了增加了畫標題文本和只畫一條橫線的處理外，其余的大同小異。
光有新的停靠管理器還不夠，我們還需要讓停靠窗體使用這個停靠管理器，因此要重載窗體的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提供的停靠功能是非常強大，而且很容易擴展，一點不足就是默認的停靠管理器有一些Bug，同時界面繪制略顯單調了一些，相關文檔也比較少。希望通過這篇文章的介紹，大家可以以此為起點寫出更為專業的停靠界面，秀出真我的色彩來。
轉載于:https://www.cnblogs.com/spiritofcloud/p/3976171.html
總結
以上是生活随笔為你收集整理的高级停靠(Dock)技术的实现的全部內容，希望文章能夠幫你解決所遇到的問題。
