Implementation. Процедура CMDockclient позволяет подключить к

End.

Процедура CMDockclient позволяет подключить к. приложению новые доки из двух подключенных модулей. Если сообщение клиента о возможно­сти присоединения было проигнорировано (в данном случае основной фор­мой), то процедура CMDockclient строит с помощью объявленной вспомо­гательной переменной Host один из двух объявленных в модулях uCon-joinHost и 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 FormOnDock (Sender: TObject; Client: TControl;

NewTarget: TWinControl; var Allow: Boolean);

procedure FonnDockOver (Sender: TObject; Source: TDragDockObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

procedure FormGetSitelnfо (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.FonnDockOver (Sender:

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

State: TDragState; var Accept: Boolean); begin

Accept:= Source.Control is TDockableForm;

end;

procedure TConjoinDockHost.FormGetSitelnfо (Sender:

TObject; DockClient: TControl; var InfluenceRect:

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

CanDock:= DockClient is TDockableForm;

end;

end.

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

Рис. 58

Последняя форма (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 PageControllUnDock (Sender: TObject; Client: TControl; NewTarget: TWinControl; var Allow: Boolean);

procedure PageControllGetSitelnfo (Sender: TObject; DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);

procedure PageControllDockOver (Sender: TObject; Source: TDragDockObject; X, Y: Integer;

State: TDragState; var Accept: Boolean); end;

var TabDockHost: TTabDockHost;

{$R *.dfm}

uses uDockForm;

procedure TTabDockHost.FormClose (Sender: TObject;

var Action: TCloseAction); var ARect: TRect;^ begin

if PageControll.DockClientCount = 1 then begin

with PageControll.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.PageControllUnDock (Sender: TObject;

Client:TControl; NewTarget:TWinControl;

var Allow:Boolean)

begin

if (PageControll.DockClientCount = 2) and (NewTarget <> Self) then PostMessage(Self.Handle, WM_CLOSE, 0, O);

end;

procedure TTabDockHost.PageControllGetSitelnfo (Sender: TObject; DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);

begin

CanDock:= DockClient is TDockableForm;

end;

procedure TTabDockHost.PageControllDockOver (Sender: TObject; Source: TDragDockObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

begin

Accept:= Source.Control is TDockableForm;

end;

Дата добавления: 2014-12-29