Delphi高级停靠(Dock)技术的实现VIP

高级停靠(Dock)技术的实现介绍所谓停靠就是可以用鼠标拖动窗体或者控件，并将其从一个父窗体移出或者移动到另一个父窗体上，可以按水平，垂直方向整齐排列， 并且可以停靠在分页控制组件上。下面的示意图是一个Delphi IDE的窗口停靠示意图：考察一些常用的软件如Office等大型软件，会发现大多提供窗体停靠的功能。微软的MFC很早就引入了工具条的拖放功能，可以将工具条上窗口上边拖放到窗口下边。而Borland则最早在Delphi 4中开始引入停靠功能支持，它实际上就是基于前面我们讲到的VCL拖放技术基础之上的，后面我们会看到两者有多么的类似。Borland提供了停靠功能的一个演示程序，可以在.DemosDocking目录下找到它，不过这个例子的问题就是太过复杂，使用了很多的高级技巧，不易理解。所以我将抛开复杂的示例，一步一步的揭开停靠的秘密。一个简单的停靠实现工具条的停靠功能是最常见的功能需求，新建一个程序，在窗体上放置一个工具条，然后任意添加几个按钮，为了让工具条能够从窗体上移出，最简单的办法是设定工具条的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);beginToolbar1.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);beginToolbar1.Visible:=True;end;再次运行修改后的停靠程序，多拖放停靠几次后，我们又会发现一个新的问题，那就是虽然浮动工具条可以被停靠回主界面，但是位置不再是同界面顶部对齐，而是可以停靠在任意位置上，这显然不是我们想要的效果，什么原因造成的呢？怎么解决呢？原来，VCL在拖离任何控件后，都会将控件的Align属性修改为alNone，要想解决这个问题，就需要在工具条停靠在窗体上之后将工具条的Align属性重新设定为alTop。幸好同拖放操作一样，在停靠组件时，VCL同样会产生一系列的事件，其中 OnEndDock事件会在停靠完成后发生，正好满足我们的需要，实现的工具条的OnEndDock事件如下：procedure TForm1.ToolBar1EndDock(Sender, Target: TObject; X, Y: Integer);beginToolbar1.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);beginAccept:=(Source.Control.Name=ToolBar1);end;procedure TForm1.Panel2DockOver(Sender: TObject; Source: TDragDockObject;X, Y: Integer; State: TDragState; var Accept: Boolean);beginAccept:=(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);beginAccept := (Source.Control.Name = ToolBar2);if not Accept thenSource.DockRect := AdjustDockRect(Sender, Source, X, Y);end;function TForm1.AdjustDockRect(Sender: TObject; Source: TDragDockObject; X, Y:Integer): TRect;varARect: 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);beginCanDock:=DockClient.Name=ToolBar1;end;procedure TForm1.Panel2GetSiteInfo(Sender: TObject; DockClient: TControl;var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);beginCanDock:=DockClient.Name=ToolBar2;end;可以看到这种方式要比前一种方式简洁得多。手工停靠前面我们介绍的主要是通过鼠标的拖放动作来实现的组件的停靠，VCL还提供了ManualDock和ManualFloat过程来实现手工Dock和UnDock的功能，将前面的简单停靠中切换工具条是否显示的菜单命令修改如下：procedure TForm1.ActionViewToolBarUpdate(Sender: TObject);beginif (Toolbar1.Visible and not Toolbar1.Floating)then(Sender as TAction).Caption:=UnDockelse(Sender as TAction).Caption:=Dock;end;procedure TForm1.ActionViewToolBarExecute(Sender: TObject);beginif (Sender as TAction).Caption=Dock thenbeginToolbar1.ManualDock(Form1, nil, alTop);/如果 Dock 的目标是窗体，必须加上下面两句话，如果是其它控件则不需要，这是 VCL 中 /的一个 bugToolbar1.Align:=alTop;Toolbar1.Visible:=True;endelseToolbar1.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: TPanelAlign = alTopDockSite = Trueendobject PanelLeft: TPanelAlign = alLeftDockSite = Trueendobject PanelRight: TPanelAlign = alRightDockSite = Trueendobject PanelBottom: TPanelAlign = alBottomDockSite = Trueendobject PanelMain: TPanelAlign = alClientend放上一个工具条，设定工具条 DragKind 属性为 dkDock，实现 Toolbar1 的OnMouseDown 事件如下：procedure TForm1.ToolBar1MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);beginToolbar1.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);varDockBar: TToolBar;InflateSize: Integer;ARect: TRect;ClientTL: TPoint;beginDockBar := Source.Control as TToolBar;/如果处于水平状态，获得工具条的高度，如果处于垂直状态，获得工具条的宽度 if DockBar.