home *** CD-ROM | disk | FTP | other *** search
/ PC World Plus! (NZ) 2001 June / HDC50.iso / Runimage / Delphi50 / Demos / Docking / TABHOST.PAS < prev   
Pascal/Delphi Source File  |  1999-08-11  |  2KB  |  79 lines
  1. unit TabHost;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ComCtrls;
  8.  
  9. type
  10.   TTabDockHost = class(TForm)
  11.     PageControl1: TPageControl;
  12.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  13.     procedure PageControl1UnDock(Sender: TObject; Client: TControl;
  14.       NewTarget: TWinControl; var Allow: Boolean);
  15.     procedure PageControl1GetSiteInfo(Sender: TObject;
  16.       DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint;
  17.       var CanDock: Boolean);
  18.     procedure PageControl1DockOver(Sender: TObject;
  19.       Source: TDragDockObject; X, Y: Integer; State: TDragState;
  20.       var Accept: Boolean);
  21.   private
  22.  
  23.    { Private declarations }
  24.   public
  25.     { Public declarations }
  26.   end;
  27.  
  28. var
  29.   TabDockHost: TTabDockHost;
  30.  
  31. implementation
  32.  
  33. {$R *.DFM}
  34.  
  35. uses DockForm;
  36.  
  37. procedure TTabDockHost.FormClose(Sender: TObject;
  38.   var Action: TCloseAction);
  39. var
  40.   ARect: TRect;
  41. begin
  42.   if PageControl1.DockClientCount = 1 then
  43.   begin
  44.     with PageControl1.DockClients[0] do
  45.     begin
  46.       ARect.TopLeft := ClientToScreen(Point(0, 0));
  47.       ARect.BottomRight := ClientToScreen(Point(UndockWidth, UndockHeight));
  48.       ManualFloat(ARect);
  49.     end;
  50.     Action := caFree;
  51.   end else
  52.     Action := caHide;
  53. end;
  54.  
  55. procedure TTabDockHost.PageControl1UnDock(Sender: TObject;
  56.   Client: TControl; NewTarget: TWinControl; var Allow: Boolean);
  57. begin
  58.   //only 2 dock clients means the host must be destroyed and
  59.   //the remaining window undocked to its old position and size.
  60.   if (PageControl1.DockClientCount = 2) and (NewTarget <> Self) then
  61.     PostMessage(Self.Handle, WM_CLOSE, 0, 0);
  62. end;
  63.  
  64. procedure TTabDockHost.PageControl1GetSiteInfo(Sender: TObject;
  65.   DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint;
  66.   var CanDock: Boolean);
  67. begin
  68.   CanDock := DockClient is TDockableForm;
  69. end;
  70.  
  71. procedure TTabDockHost.PageControl1DockOver(Sender: TObject;
  72.   Source: TDragDockObject; X, Y: Integer; State: TDragState;
  73.   var Accept: Boolean);
  74. begin
  75.   Accept := Source.Control is TDockableForm;
  76. end;
  77.  
  78. end.
  79.