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

1、高级停靠 (Dock)技术的实现 介绍 所谓停靠就是可以用鼠标拖动窗体或者控件，并将其从一个父窗体移出或者移动到另一个父窗体上，可以按水平，垂直方 向整齐排列， 并且可以停靠在分页控制组件上。下面的示意图是一个 Delphi IDE的窗口停靠示意图： 考察一些常用的软件如 Office等大型软件，会发现大多 提供窗体停靠的功能。微软的 MFC很早就引入了工具条的拖放功能， 可以将工具条上窗口上边拖放到窗口下边。而 Borland则最早在 Delphi 4中开始引入停靠功能支持，它实际上就是基于前 面我们讲到的 VCL拖放技术基础之上的，后面我们会看到两者有多么的类似。Borland提供了停靠功

2、能的一个演示程序， 可以在 .DemosDocking目录下找到它，不过这个例子的问题就是太过复杂，使用了很多的高级技巧，不易理解。所以我 将抛开复杂的示例，一步一步的揭开停靠的秘密。 一个简单的停靠实现 工具条的停靠功能是最 常见的功能需求，新建一个程序，在窗体上放置一个工具条，然后任意添加几个按钮，为了让工具条 能够从窗体上移出，最简单的办法是设定工具条的 DragMode属性为 dmAutomatic，将 DragKind属性设定为 dkDock。就像在拖 放类一章我们说的， DragMode设定为 dmAutomatic表示当鼠标在工具条上点击并移动后，会自动发起拖放动作。而 Drag

3、Kind 为 dkDock表示接下来的操作是一个停靠操作而不是普通的拖放操作。 运行这个简单的程序，然后拖放工具条，我们发现确实可以将工具条拖离主窗体使其变 成一个浮动的工具条。注意在工具条 从窗体拖离时， VCL会在屏幕上画一个矩形表示工具条，我们称其为停靠图像。见下图： 可以看到， VCL强大的停靠支持使我们不用写一行代码就可以实现简单的停靠功能了，但是上面的程序存在几个问题： 1、 由于使用了 dmAutomatic属性，哪怕是单击一下工具条不做任 何拖动，都会使它变成浮动的工具条。 2、 拖离窗体后变成浮动的工具条无法停靠回原来的位置。 3、 浮动的工具条窗口可以被关闭，而关闭后再也没

4、办法调出工具条了。 对于第一个问题，为了实现工具条在鼠标点击后，必须拖放几个像素后才能被拖离界面，可以像前面拖放类章节中所讲 的那样，设定工具条的 DragMode为 dmManual的手工模式，然后在工具条的OnMouseDown事件中使用拖放函数 BeginDrag来发起 拖离的动作： procedure TForm1.ToolBar1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Toolbar1.BeginDrag(False); end; 而为了让浮动

5、工具条能够被停靠回主界面，我们需要设定窗体的 DockSite属性为True，表示窗体是一个停靠的锚点，允许 别的控件停靠在它上面。 而当关闭浮动工具条窗口时， VCL其实并没有销毁工具条，它只是将工具条的Visible属性设为 False，使其不可见，为 了重新显示 工具条，我们可以通过一个菜单命令，将其属性设为 True。下面是添加的察看工具条的 Action的代码，其中 Update 事件判断工具条是否可见，如果不可见，则允许执行 Action的 OnExecute事件： procedure TForm1.ActionViewToolBarUpdate(Sender: TObject);

6、 begin (Sender as TAction).Enabled:=not Toolbar1.Visible; end; procedure TForm1.ActionViewToolBarExecute(Sender: TObject); begin Toolbar1.Visible:=True; end; 再次运行修改后的停靠程序，多拖放停靠几次后，我们又会发现一个新的问题，那就是虽然浮动工具条可以被停靠回主界面 ，但是位置不再是同界面顶部对齐，而是可以停靠在任意位置上，这显然不是我们想要的效果，什么原因造成的呢？怎么解 决呢？ 原来， VCL在拖离任何控件后，都会将控件的 Align

7、属性修改为 alNone，要想解决这个问题，就需要在工具条停靠在窗体上之 后将工具条的 Align属性重新设定为 alTop。幸好同拖放操作一样，在停靠组件时，VCL同样会产生一系列的事件，其中 OnEndDock事件会在停靠完成后发生，正好满足我们的需要，实现的工具条的 OnEndDock事件如下： procedure TForm1.ToolBar1EndDock(Sender, Target: TObject; X, Y: Integer); begin Toolbar1.Align:=alTop; end; 复杂界面的停靠 上面的停靠功能可以满足简单界面的需求了，那么考虑一个复杂的界面停

8、靠操作。假设你的项目经理要求你在主界面上放置 两个面板，上面的面板上有一个工具条，下面的面板上也有一个工具条。两个面板上的工具条都停靠操作，但是有一个要求 是上面面板的工具条只能停靠在上面的面板上，同样下面的工具条也只能停靠在下面的面板上。 当组件在要停靠的组件上被拖动时，会调用被停靠组件的 OnDockOver 事件， OnDockOver 的事件定义如下； type TDockOverEvent = procedure(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept

9、: 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.Con

10、trol.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 仍然会在修改 Toolba

11、r1 的停靠矩形为 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 = ToolB

12、ar2); 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);

13、/根据被拖放的工具条的尺寸计算出右下角坐标 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); Resul

14、t:=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，则后面的 D

15、ockOver就不会被调用了，也就无须修改工具条停靠矩形了。我们需要就是判断 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: T

16、Object; DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean); begin CanDock:=DockClient.Name=ToolBar2; end; 可以看到这种方式要比前一种方式简洁得多。 手工停靠 前面我们介绍的主要是通过鼠标的拖放动作来实现的组件的停靠， VCL还提供了ManualDock和 ManualFloat过程来实现手工 Dock和 UnDock的功能，将前面的简单停靠中切换工具条是否显示的菜单命令修改如下： procedure TForm1.A

17、ctionViewToolBarUpdate(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 Toolbar

18、1.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时，表示它正处于浮动状态，我们可以进行停靠操作，反之则进

19、行 UnDock操作，使用 ManualDock时，需要指定停靠目标为 Form1，对齐方式为 alTop，注意至少在Delphi7中，将工具条手工停 靠到窗体有问题 ，无法看到正确的结果，必须在重新设定一下 Visible和 Align属性，但是如果停靠目标是面板等其它控件，则没有问题， 这应该是 VCL中的 bug。而使用 ManualFloat使控件处于浮动状态时，需要指定浮动区域的矩形位置和大小，矩形的宽和高 对应于工具条的 UndockWidth和 UndockHeight属性。 管理停靠区域 凡是用过 Word的人都知道， Word中的工具条的停靠能力非常强，不仅可以停靠在文字编辑

20、器的顶部，还可以停靠在左边， 右边和下边，那么我们如果用 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 DockSi

21、te = 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); b

22、egin Toolbar1.BeginDrag(False); end; 运行程序，可以看到工具条确实可以在窗体的四周停靠，但是工具条始终是水平排布的，在停靠到 左边时变成垂 直排布，所以我们要在拖放完成时，修改工具条的 align属性，当组件在被停靠面板上释放时，会调用面板的 OnDragDrop 事件，我们可以在该事件中修改工具条的属性。 新的问题又产生了， Word的停靠在上下左右都没有明显可见的停靠目标控件，而我们则使用了四个很明显的面板，为此要 修改面板的 AutoSize 属性为 True，这样当没有控件在面板上时，将面板的宽或高调整为 0，这样运行时，用户就看不到面 板了，同时虽

23、然面板的尺寸变小了，但是 VCL 响应拖放的矩形区域其实是真实面板的尺寸在各个方向上都加 上 10个像素，所 以面板仍然能够响应工具条的拖放动作。再次运行程序，会发现程序运行的效果这回和 Word 几乎一模一样了。 但是，有点美中不足的是，由于面板在没有工具条时自动调整面板的大小，设定宽或高为 0，这是显示的工具条的停靠矩形 跟缩小的面板尺寸进行匹配后画出来的就是一个非常狭长的矩形，视觉效果不佳。因为 VCL 是在停靠工具条在被停靠面板上 移动时画停靠矩形的，所以我们可以像前面那样在面板的 OnDockOver 事件中对DockRect 进行处理，扩大矩形区域： procedure TForm

24、1.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 DockB

25、ar.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, Inf

26、lateSize); 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; 调整前的效果：