Function TDockableForm.ComputeDockingRect

......

end;

procedure TDockableForm.FormClose (Sender: TObject;

var Action: TCloseAction);

begin

if (HostDockSite is TConjoinDockHost) then

if HostDockSite.VisibleDockClientCount <= 1

then HostDockSite.Hide;

if (HostDockSite is TPanel) then

MainForm.ShowDockPanel(HostDockSite as TPanel,

False, nil);

Action:= caHide;

end;

procedure TDockableForm.CMDockClient (

var Message: TCMDockClient);

var ARect: TRect;

DockType: TAlign;

Host: TForm;

Pt: TPoint;

begin

if Message.DockSource.Control is TDockableForm then

begin

Pt.x:= Message.MousePos.x;

Pt.y:= Message.MousePos.y;

DockType:= ComputeDockingRect(ARect, Pt);

if (HostDockSite is TPanel) then begin

Message.DockSource.Control.ManualDock(

HostDockSite, nil, DockType);

Exit;

end;

if DockType = alClient then begin

Host:= TTabDockHost.Create(Application);

Host.BoundsRect:= Self.BoundsRect;

Self.ManualDock(TTabDockHost(Host).PageControl1,

nil, alClient);

Message.DockSource.Control.ManualDock(

TTabDockHost(Host).PageControl1, nil, alClient);

Host.Visible:= True;

end else begin

Host:= TConjoinDockHost.Create(Application);

Host.BoundsRect:= Self.BoundsRect;

Self.ManualDock(Host, nil, alNone);

Message.DockSource.Control.ManualDock(

Host, nil, DockType);

Host.Visible:= True;

end;

end;

end;

End.

Процедура CMDockClient позволяет подключить к приложению новые доки из двух подключенных модулей. Если сообщение клиента о возможности присоединения было проигнорировано (в данном случае основной формой), то процедура CMDockClient строит с помощью объявленной вспомогательной переменной Host один из двух объявленных в модулях uConjoinHost и uTabHost новых доков и после дополнительных проверок пытается пристыковать клиентов с помощью нестандартных методов к этим докам. Может быть построено несколько таких доков. Один вариант формы-дока (форма-контейнер) объявлен в модуле, который приводится ниже.

unit uConjoinHost;

Interface

uses Windows, Messages, SysUtils, Classes, Graphics,

Controls, Forms, Dialogs, uDockForm;

Type

TConjoinDockHost = class(TForm)

procedure FormClose (Sender: TObject;

var Action: TCloseAction);

procedure FormDockDrop (Sender: TObject;

Source: TDragDockObject; X, Y: Integer);

procedure FormUnDock (Sender: TObject;

Client: TControl; NewTarget: TWinControl;

var Allow: Boolean);

procedure FormDockOver (Sender: TObject;

Source: TDragDockObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

procedure FormGetSiteInfo (Sender: TObject;

DockClient: TControl; var InfluenceRect: TRect;

MousePos: TPoint; var CanDock: Boolean);

private

procedure DoFloat(AControl: TControl);

end;

var ConjoinDockHost: TConjoinDockHost;

Implementation

{$R *.dfm}

procedure TConjoinDockHost.DoFloat (

AControl: TControl);

var ARect: TRect;

begin

ARect.TopLeft:=

AControl.ClientToScreen(Point(0, 0));

ARect.BottomRight:= AControl.ClientToScreen(Point

(AControl.UndockWidth, AControl.UndockHeight));

AControl.ManualFloat(ARect);

end;

procedure TConjoinDockHost.FormClose (Sender: TObject;

var Action: TCloseAction);

begin

if DockClientCount = 1 then begin

DoFloat(DockClients[0]);

Action:= caFree;

end else Action:= caHide;

end;

procedure TConjoinDockHost.FormDockDrop (Sender:

TObject; Source: TDragDockObject; X, Y: Integer);

begin

DockManager.ResetBounds(True);

end;

procedure TConjoinDockHost.FormUnDock (Sender: TObject;

Client: TControl; NewTarget: TWinControl;

var Allow: Boolean);

begin

if Client is TDockableForm then

TDockableForm(Client).DockSite:= True;

if (DockClientCount = 2) and (NewTarget <> Self)

then PostMessage(Self.Handle, WM_CLOSE, 0, 0);

end;

procedure TConjoinDockHost.FormDockOver (Sender:

TObject; Source: TDragDockObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

begin

Accept:= Source.Control is TDockableForm;

end;

procedure TConjoinDockHost.FormGetSiteInfo (Sender:

TObject; DockClient: TControl; var InfluenceRect:

TRect; MousePos: TPoint; var CanDock: Boolean);

begin

CanDock:= DockClient is TDockableForm;

end;

end.

Для формы-контейнера установлено: DockSite=true и UseDockManager=true (обязательно установить, иначе сгенерируется исключительная ситуация). На рис. 58 показан вариант пристыковки к форме-контейнеру трех клиентов.

 

Рис. 58 Вариант 3 решения примера 24.

Последняя форма (TabDockHost) не может принимать клиентов – эту функцию выполняет расположенный на ней компонент PageControl1. у которого установлено свойство DockSite=true. Модуль, в котором эта форма объявлена, приводится ниже.

unit uTabHost;

Interface

uses Windows, Messages, SysUtils, Classes, Graphics,

Controls, Forms, Dialogs, ComCtrls;

Type

TTabDockHost = class(TForm)

PageControl1: TPageControl;

procedure FormClose (Sender: TObject;

var Action: TCloseAction);

procedure PageControl1UnDock (Sender: TObject;

Client: TControl; NewTarget: TWinControl;

var Allow: Boolean);

procedure PageControl1GetSiteInfo (Sender: TObject;

DockClient: TControl; var InfluenceRect: TRect;

MousePos: TPoint; var CanDock: Boolean);

procedure PageControl1DockOver (Sender: TObject;

Source: TDragDockObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

end;

var TabDockHost: TTabDockHost;

Implementation

{$R *.dfm}

uses uDockForm;

procedure TTabDockHost.FormClose (Sender: TObject;

var Action: TCloseAction);

var ARect: TRect;

begin

if PageControl1.DockClientCount = 1 then begin

with PageControl1.DockClients[0] do begin

ARect.TopLeft:= ClientToScreen(Point(0, 0));

ARect.BottomRight:= ClientToScreen(

Point(UndockWidth, UndockHeight));

ManualFloat(ARect);

end;

Action:= caFree;

end else Action:= caHide;

end;

procedure TTabDockHost.PageControl1UnDock (Sender:

TObject; Client: TControl; NewTarget: TWinControl;

var Allow: Boolean);

begin

if (PageControl1.DockClientCount = 2) and

(NewTarget <> Self) then

PostMessage(Self.Handle, WM_CLOSE, 0, 0);

end;

procedure TTabDockHost.PageControl1GetSiteInfo (Sender:

TObject; DockClient: TControl; var InfluenceRect:

TRect; MousePos: TPoint; var CanDock: Boolean);

begin

CanDock:= DockClient is TDockableForm;

end;

procedure TTabDockHost.PageControl1DockOver (Sender:

TObject; Source: TDragDockObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

begin

Accept:= Source.Control is TDockableForm;

end;

End.

На рис. 59 отображена возможность применения формы “записная кижка” с пристыкованными к ней тремя формами (основная форма не показана). Естественно, страницы на форме можно переключать и, кроме того, делать на страницах какие-то записи.

 

Рис. 59 Вариант 4 решения примера 24.

В заключение отметим использование функции ManualDock, которая может организовать технологию Drag and Dock в случаях отсутствия необходимых установок для двух стыкующихся элементов. В частности, в модуле uDockForm выполняется операция стыковки между основной формой и клиентом, при условии, что клиент запрашивает и получает прямоугольник “причаливания” в центре основной формы (задано программно: alClient в процедуре CMDockClient). Результат такой операции представлен на рис. 60. Окно в данном случае потеряло свои стандартные кнопки и стало неуправляемым с помощью мыши. Чтобы вернуть этому окну управление, как предусмотрено в приложении, необходимо обеспечить стыковку с ним еще одного клиента. В зависимости от варианта второй стыковки может быть получен один из двух случаев, представленных на рис. 58 и 59, которые получаются при обработке полученной операции с помощью похожих обработчиков, находящихся в модуле TConjoinDockHost (FormUnDock) и модуле TTabDockHost (PageControl1UnDock).

 

Рис. 60 Вариант 5 решения примера 24.