Delphi中停靠技术的实现(2)




 


OnStartDock和OnEndDock经常会被触发，

OnUnDock只在停靠窗体变成浮动时触发

讲了那么多，大家有没有被搞糊涂？那好，我来做一下总结：

在Delphi中只要是从TWinControl继承的控件都支持被停靠(如上面的LeftDockPanel)，也就是有DockSite这个属性;所有从TControl继承的控件都支持停靠(如上面的DockableForm),也就是有DragKind这个属性.所以支持被停靠的控件都支持停靠，支持停靠的控件不一定支持被停靠，道理很简单，因为TWinControl继承于TControl。OnDockOver事件是控制停靠窗体的预览位置；OnDockDrap事件是控制停靠窗体的最终位置；OnGetSiteInfo是询问是否可以停靠；OnStartDock是停靠开始，OnEndDock是停靠结尾，OnUnDock是不停靠(也就是被拖出来时)。



想必Delphi用的熟的大虾都知道在Delphi的可停靠窗体间可以相互停靠，而且花样还很多，可以停靠成并排的，也可以停靠成PageControl样式的，两个可停靠窗体合并后的窗体又可以再和别的可停靠窗体合并，形成树状。下面来介绍这方面的技术：

说道这里，我们不得不介绍一下CM_DOCKCLIENT消息和TCMDockClient结构，

CM_DOCKCLIENT消息和TCMDockClient结构是相互对应的，TCMDockClient的结构是：

 TCMDockClient = packed record

   Msg: Cardinal;

   DockSource: TDragDockObject;

   MousePos: TSmallPoint;

   Result: Integer;

 end;

其中DockSource包含了停靠—拖动操作的信息，前面已经提到过；MousePos是鼠标的位置。CM_DOCKCLIENT事件在停靠和被停靠控件都可以捕获，因为它是TWinControl类发出的，

代码如下：

procedure TWinControl.DockDrop(Source: TDragDockObject; X, Y: Integer);

begin

 if (Perform(CM_DOCKCLIENT, Integer(Source), Integer(SmallPoint(X, Y))) >= 0)

   and Assigned(FOnDockDrop) then

   FOnDockDrop(Self, Source, X, Y);

end;



可以看出，TWinControl是先发送DOCKCLIENT消息，再触发OnDockDrop事件的。

为了演示可停靠窗体之间相互停靠，我们先创建一个宿主窗体，取名叫TiledHost,把它的DockSite设成True。它的作用是用来装载两个DockableForm的。

首先在DockableForm中捕获DOCKCLIENT消息，在里面完成两个窗体的相互停靠

声明：

private

procedure CMDockClient(var Message: TCMDockClient); message CM_DOCKCLIENT;

end;



实现：

procedure TDockableForm.CMDockClient(var Message: TCMDockClient);

var

 Host: TForm;

begin

 if Message.DockSource.Control is TDockableForm then

 begin

Host := TTiledHost.Create(Application);

   Host.BoundsRect := Self.BoundsRect;

   Self.ManualDock(Host, nil, alNone);

   Self.DockSite := False;

   Message.DockSource.Control.ManualDock(Host, nil, alNone);

   TDockableForm(Message.DockSource.Control).DockSite := False;

   Host.Visible := True;

End;

end;

先解释一下上面的代码，首先创建TTiledHost的实例，然后用ManualDock函数把自己停靠到TTiledHost，把Message.DockSource.Control也停靠到TTiledHost，这样就完成了窗体的相互停靠，当然，要是我们要程序产生停靠的预览效果，就在DockableForm的OnDockOver事件里加入代码：

procedure TDockableForm.FormDockOver(Sender: TObject;

 Source: TDragDockObject; X, Y: Integer; State: TDragState;

 var Accept: Boolean);

var

 ARect: TRect;

begin

 Accept := Source.Control is TDockableForm;

 if Accept then

 begin

   ARect.TopLeft := ClientToScreen(Point(0, 0));

   ARect.BottomRight := ClientToScreen(

     Point(ClientWidth div 2, ClientHeight));

   Source.DockRect := ARect;

 end;

end;



怎么样，效果还可以吧。对了，需要注意的是，用ManualDock函数可以安全的完成停靠功能，不要用Dock函数。ManualDock函数有一些参数：

function ManualDock(NewDockSite: TWinControl; DropControl: TControl = nil; ControlSide: TAlign = alNone): Boolean;

NewDockSite：要被停靠的窗体；

DropControl：已经存在于NewDockSite的TControl，在这里可以把它设成nil;

ControlSide: 停靠的位置，可以是上，下，左，右，全部等。



当然，我们也可以让TiledHost也具有和LeftDockPanel一样有被停靠的功能，只要把TiledHost看成前面的LeftDockPanel，添加一些属性和事件；把TiledHost看成DockableForm，

就可以有停靠的功能了。具体的做法这里不再阐述了，相信对VCL有深刻研究的大虾都知道怎么做了。





下面我来讲一下两个窗体怎样停靠成PageControl样式。

首先创建一个窗体，叫TabHost，在它上面放一个PageControl,Align属性设成alClient,让它占满整个TabHost，别忘了把PageControl的DockSite属性设成True.

然后我们依次加入代码：

procedure TDockableForm.FormDockOver(Sender: TObject;

 Source: TDragDockObject; X, Y: Integer; State: TDragState;

 var Accept: Boolean);

var

 ARect: TRect;

begin

 Accept := Source.Control is TDockableForm;

 if Accept then

 begin

   ARect.TopLeft := ClientToScreen(ClientRect.TopLeft);

   ARect.BottomRight := ClientToScreen(ClientRect.BottomRight);

   Source.DockRect := ARect;

 end;

和

procedure TDockableForm.CMDockClient(var Message: TCMDockClient);

var

 Host: TForm;

begin

 if Message.DockSource.Control is TDockableForm then

 begin

     Host := TTabHost.Create(Application);

     Host.BoundsRect := Self.BoundsRect;

     Self.ManualDock(TTabHost(Host).PageControl1, nil, alClient); 

 Message.DockSource.Control.ManualDock(TTabHost(Host).PageControl1, nil, alClient);

     Host.Visible := True;

      End;

End;

代码的具体意思在这里就不再解释了，同理也可以让TabHost具有停靠和被停靠的功能。还需要说明一下，TPageControl封装了一些对停靠的支持，它捕获了CM_DOCKCLIENT，

CM_DOCKNOTIFICATION，CM_UNDOCKCLIENT，WM_LBUTTONDBLCLK消息处理停靠动作。具体可以查看TPageControl的原代码。



工具条的停靠也一样，在主窗体上放一个ControlBar或CoolBar，把他们的DockSite设成True；再在上面放ToolBar, ToolBar的DragKind属性设成dkDock，DragMode属性设为dmAutomatic。在这里，TControl有一个属性叫FloatingDockSiteClass，它的类型是TWinControl的引用(class of TWinControl),只要在主窗口创建时，把ToolBar的FloatingDockSiteClass属性设成某一个窗体A，比如在设计时A这个窗体叫ToolBarDockForm,但在程序里面不用显式的创建A，Delphi会自动创建，当ToolBar被拖动出来时，Delphi自动把它装载到ToolBarDockForm里，当然ToolBarDockForm也要象上面提到的DockableForm一样设置一定的属性和添加一些代码。



讲了一大堆，还是没有把Delphi支持的停靠功能全部讲完，据我所知，还有很多。还是把它们列出来供大家参考（前面介绍的就省略了）

属性：

1．TControl. TBDockHeight               //存储停靠控件在停靠时的的高度；

2．TControl. LRDockWidth                //存储停靠控件在停靠时的的宽度；

3．TControl. UnDockHeight               //存储停靠控件在浮动时的的高度；

4．TControl. UnDockWidth             &nbs

补充：软件开发 , Delphi ,