Dock
複雜界面的停靠
上面的停靠功能可以滿足簡單界面的需求了，那麼考慮一個複雜的界面停靠操作。假設你的項目經理要求你在主界面上放置
兩個面板，上面的面板上有一個工具條，下面的面板上也有一個工具條。兩個面板上的工具條都停靠操作，但是有一個要求
是上面面板的工具條只能停靠在上面的面板上，同樣下面的工具條也只能停靠在下面的面板上。
當組件在要停靠的組件上被拖動時，會調用被停靠組件的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，同時
界面繪製略顯單調了一些，相關文檔也比較少。希望通過這篇文章的介紹，大家可以以此爲起點寫出更爲專業的停靠界面，
秀出真我的色彩來。