Delphi高级停靠(Dock)技术的实现.doc_第1页
Delphi高级停靠(Dock)技术的实现.doc_第2页
Delphi高级停靠(Dock)技术的实现.doc_第3页
Delphi高级停靠(Dock)技术的实现.doc_第4页
Delphi高级停靠(Dock)技术的实现.doc_第5页
已阅读5页,还剩21页未读 继续免费阅读

下载本文档

版权说明:本文档由用户提供并上传,收益归属内容提供方,若内容存在侵权,请进行举报或认领

文档简介

高级停靠(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);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 beginToolbar1.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: TPanelAlign = alTopDockSite = Trueend object PanelLeft: TPanelAlign = alLeftDockSite = True end object PanelRight: TPanelAlign = alRightDockSite = Trueend object PanelBottom: TPanelAlign = alBottomDockSite = 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 := ARectend;调整前的效果:调整后的效果:分页停靠在本文的第一个示意图上可以看到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 = dmAutomaticShape = stEllipseend object Panel1: TPanel Align = alRightDockSite = 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 DockClients0.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 DockClients0.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 *.dfmprocedure TForm1.FormCreate(Sender: TObject);const Colors: array1.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 := ColorsI; 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; Sour

温馨提示

  • 1. 本站所有资源如无特殊说明,都需要本地电脑安装OFFICE2007和PDF阅读器。图纸软件为CAD,CAXA,PROE,UG,SolidWorks等.压缩文件请下载最新的WinRAR软件解压。
  • 2. 本站的文档不包含任何第三方提供的附件图纸等,如果需要附件,请联系上传者。文件的所有权益归上传用户所有。
  • 3. 本站RAR压缩包中若带图纸,网页内容里面会有图纸预览,若没有图纸预览就没有图纸。
  • 4. 未经权益所有人同意不得将文件中的内容挪作商业或盈利用途。
  • 5. 人人文库网仅提供信息存储空间,仅对用户上传内容的表现方式做保护处理,对用户上传分享的文档内容本身不做任何修改或编辑,并不能对任何下载内容负责。
  • 6. 下载文件中如有侵权或不适当内容,请与我们联系,我们立即纠正。
  • 7. 本站不保证下载资源的准确性、安全性和完整性, 同时也不承担用户因使用这些下载资源对自己和他人造成任何形式的伤害或损失。

评论

0/150

提交评论