uTabHost.pas
上传用户:lmk588
上传日期:2013-04-16
资源大小:5120k
文件大小:2k
源码类别:

按钮控件

开发平台:

Delphi

  1. unit uTabHost;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5.   ComCtrls;
  6. type
  7.   TTabDockHost = class(TForm)
  8.     PageControl1: TPageControl;
  9.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  10.     procedure PageControl1UnDock(Sender: TObject; Client: TControl;
  11.       NewTarget: TWinControl; var Allow: Boolean);
  12.     procedure PageControl1GetSiteInfo(Sender: TObject;
  13.       DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint;
  14.       var CanDock: Boolean);
  15.     procedure PageControl1DockOver(Sender: TObject;
  16.       Source: TDragDockObject; X, Y: Integer; State: TDragState;
  17.       var Accept: Boolean);
  18.   private
  19.    { Private declarations }
  20.   public
  21.     { Public declarations }
  22.   end;
  23. var
  24.   TabDockHost: TTabDockHost;
  25. implementation
  26. {$R *.dfm}
  27. uses uDockForm;
  28. procedure TTabDockHost.FormClose(Sender: TObject;
  29.   var Action: TCloseAction);
  30. var
  31.   ARect: TRect;
  32. begin
  33.   if PageControl1.DockClientCount = 1 then
  34.   begin
  35.     with PageControl1.DockClients[0] do
  36.     begin
  37.       ARect.TopLeft := ClientToScreen(Point(0, 0));
  38.       ARect.BottomRight := ClientToScreen(Point(UndockWidth, UndockHeight));
  39.       ManualFloat(ARect);
  40.     end;
  41.     Action := caFree;
  42.   end else
  43.     Action := caHide;
  44. end;
  45. procedure TTabDockHost.PageControl1UnDock(Sender: TObject;
  46.   Client: TControl; NewTarget: TWinControl; var Allow: Boolean);
  47. begin
  48.   //only 2 dock clients means the host must be destroyed and
  49.   //the remaining window undocked to its old position and size.
  50.   if (PageControl1.DockClientCount = 2) and (NewTarget <> Self) then
  51.     PostMessage(Self.Handle, WM_CLOSE, 0, 0);
  52. end;
  53. procedure TTabDockHost.PageControl1GetSiteInfo(Sender: TObject;
  54.   DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint;
  55.   var CanDock: Boolean);
  56. begin
  57.   CanDock := DockClient is TDockableForm;
  58. end;
  59. procedure TTabDockHost.PageControl1DockOver(Sender: TObject;
  60.   Source: TDragDockObject; X, Y: Integer; State: TDragState;
  61.   var Accept: Boolean);
  62. begin
  63.   Accept := Source.Control is TDockableForm;
  64. end;
  65. end.