Пример приложения 24

Рис.53

Данный пример демонстрирует некоторые возможности технологии пе­ретаскивания элементов или форм на другие формы или элементы. На рис. 53 представлен общий интерфейс примера и основная форма с пристыкован­ными к ней двумя формами-клиентами. Эти формы пристыкованы не непо­средственно на основную форму, а при помощи двух компонентов TPanel.

185

Программа состоит из четырех модулей. Основной модуль (uMain) со­держит форму основного дока, которая строится в процессе запуска прило­жения. Модуль (uDockForm) содержит объявление формы-клиента, на кото­рой расположен один компонент ТМешо. При желании можно ввести неко­торый текст в этом редакторе. Формы-клиенты строятся при создании ос­новной формы. Предусмотрено построение сразу семи форм, отличающихся цветом. Первоначально все эти семь форм невидимы.

Остальные два модуля, как и основная форма, содержат объявления форм-доков: В модуле uConjoinHost объявляется простая форма, а в uTab-Host - форма, содержащая компонент TpageControl, т.е. форма в виде за­писной книжки, состоящей первоначально из одной страницы. Все формы имеют соответствующие заголовки для простоты их распознавания.

Вначале рассмотрим простой вариант данного примера без применения модулей uConjoinHost и uTabHost и соответствующих дополнительных форм. Ниже приводится программный код основного модуля.

unit uMain; interface

uses Windows, Messages, SysUtils, Classes, Graphics,

Controls, Forms, Dialogs, Menus, StdCtrls,

ComCtrls, ActnList, ToolWin, ExtCtrls, uDockForm; type TMainForm = class(TForm)

CoolBar1: TCoolBar;

ToolBar1: TToolBar;

ToolBar2: TToolBar;

ToolButton1: TToolButton;

ToolButton2: TToolButton;

ToolButton3: TToolButton;

ToolButton4: TToolButton;

ToolButton5: TToolButton;

ToolButton6: TToolButton;

ToolButton7: TToolButton;

btnToolBar1: TToolButton;

btnToolBar2: TToolButton;

ActionList1: TActionList;

ViewToolBar1: TAction;

ViewToolBar2: TAction;

ExitAction: TAction;

ViewYellowWindow: TAction;

ViewBlueWindow: TAction;

ViewGreenWindOw: TAction;

ViewRedWindow: TAction;

ViewTealWindow: TAction;

ViewPurpleWindow: TAction;

ViewLimeWindow: TAction;

LeftDockPanel: TPanel;

186

BottomDockPanel: TPanel;

VSplitter: TSplitter;

HSplitter: TSplitter;

MainMenu1: TMainMenu;

File2: TMenuItem;

Exit2: TMenuItem;

View2: TMenuItem;

ToolBar21: TMenuItem;

ToolBar1l: TMenuItem;

Yellowl: TMenuItem;

Bluel: TMenuItem;

Greenl: TMenuItem;

Limel: TMenuItem;

Purplel: TMenuItem;

Redl: TMenuItem;

Teall: TMenuItem;

procedure FormCreate(Sender: TObject);

procedure ViewToolBar1Execute(Sender: TObject);

procedure ViewToolBar2Execute(Sender: TObject);

procedure ExitActionExecute(Sender: TObject);

procedure ViewClxentWindowExecute(Sender: TObject);

procedure CoolBar1DockOver(Sender: TObject;

Source: TDragDockObject; X, Y: Integer;

State: TDragState; var Accept: Boolean); procedure LeftDockPanelDockOver(Sender:TObject;

Source : TDragDockObject; X, Y: Integer;

State: TDragState; var Accept: Boolean); procedure LeftDockPanelDockDrop(Sender: TObject;

Source: TDragDockObject; X, Y: Integer); procedure LeftDockPanelDnDock(Sender: TObject; Client:

TControl; NewTarget: TWinControl; var Allow: Boolean); procedure LeftDockPanelGetSitelnfо(Sender: TObject;

DockClient: TControl; var InfluenceRect:

TRect; MousePos: TPoint; var CanDock: Boolean); procedure BottoxnDockPanelDockOver(Sender: TObject;

Source: TDragDockObject; X, Y: Integer;

State: TDragState; var Accept: Boolean); public

procedure ShowDockPanel(APanel: TPanel;

MakeVisible: Boolean; Client: TControl);

var MainForm: TMainForm;

implementation

{uses uTabHost, uConjoinHost;}

{$R *.dfm}

const .

Colors: array [0..6] of TColor = (clYellow, clBlue,

clGreen, clRed, clTeal, clPurple, clLime);

187

ColStr: array[0..6] of string = ('Yellow', 'Blue',

'Green^’, 'Red', 'Teal^’, 'Purple', 'Lime');

var DockWindows: array[0..6] of TDockableForm; procedure TMainForm.FormCreate(Sender: TObject);

var I: Integer;

begin

for I := 0 to High(DockWindows) do begin

DockWindows[I] := TDockableForm.Create(Application); DockWindows[I].Caption := ColStr[I]; DockWindows[I].Memo1.Color := Colors[I]; DockWindows[I].Memo1.Font.Color :=

Colors[I] xor $00FFFFFF;

DockWindows[I].Memo1.Text:=ColStr[I] + ' window';

end;

end;

procedure TMainForm.ShowDockPanel(APanel: TPanel;

MakeVisible: Boolean; Client: TControl);

begin

if not MakeVisible and

(APanel.VisibleDockClientCount > 1) then Exit;

if APanel = LeftDockPanel then

VSplitter.Visible := MakeVisible

else HSplitter.Visible := MakeVisible;

if MakeVisible then

if Apanel = LeftDockPanel then begin

APanel.Width := ClientWidth div 3;

VSplitter.Left := APanel.Width + VSplitter.Width;

End else begin

APanel.Height := ClientHeight div 3;

HSplitter.Top : = ClientHeight - APanel.Height -

HSplitter.Width;

end else if APanel = LeftDockPanel then APanel.Width := 0

else APanel.Height := 0;

if MakeVisible and (Client <> nil) then Client.Show;

end;

procedure TMainForm.ViewToolBar1Execute(Sender: TObject); begin

ToolBar1l.Checked := not ToolBar1l.Checked; btnToolBar1.Down := ToolBar1l.Checked;

if ToolBar1.Floating then

ToolBar1.HostDockSite.Visible := ToolBar1l.Checked

else ToolBar1.Visible := ToolBar1l.Checked;

end;

procedure TMainForm.ViewToolBar2Execute(Sender: TObject); begin

ToolBar21.Checked := not ToolBar21.Checked; btnToolBar2.Down := ToolBar21.Checked;

if ToolBar2.Floating then

188

TToolDockForm(ToolBar2.HostDockSite).Visible :=

ToolBar21.Checked

else ToolBar2.Visible := ToolBar21.Checked; end;

procedure TMainForm.ExitActionExecute(Sender: TObject); begin

Close; end;

procedure TMainForm.ViewClientWindowExecute(Sender: TObject); var DockWindow: TDockableForm;

begin

DockWindow :=

DockWindows[(Sender as TComponent).Tag]; with DockWindow do

if HostDockSite is TPageControl then

TTabDockHost(HostDockSite.Owner).Show

else if (HostDockSite is TConjoinDockHost) and not HostDockSite.Visible then begin

HostDockSite.Show;

DockWindow.Show;

end else if (HostDockSite is TPanel) and (((HostDockSite.Height = 0) or (HostDockSite.Width = 0)) then MainForm.ShowDockPanel(

HostDockSite as TPanel, True, DockWindow)

else DockWindow.Show;

end;

procedure TMainForm.CoolBar1DockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean);

var ARect: TRect;

begin

Accept := (Source.Control is TToolBar); if Accept then begin

ARect.TopLeft := CoolBar1.ClientToScreen(

CoolBar1.ClientRect.TopLeft); ARect.BottomRight := CoolBar1.ClientToScreen(

CoolBar1.ClientRect.BottomRight); Source.DockRect := ARect;

end;

end;

procedure TMainForm.LeftDockPanelDockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean);

var ARect: TRect;

begin

Accept := Source.Control is TDockableForm; if Accept then begin

189

ARect.TopLeft :=

LeftDockPanel.ClientToScreen(Point(0, 0) ) ; ARect.BottomRight := LeftDockPanel.ClientToScreen(

Point(Self.ClientWidth div 3, LeftDockPanel.Height)); Source.DockRect := ARect;

end;

end;

procedure TMainForm.LeftDockPanelDockDrop(Sender:

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

if (Sender as TPanel).DockClientCount = 1 then

ShowDockPanel(Sender as TPanel, True, nil)? (Sender as TPanel).DockManager.ResetBounds(True); end;

procedure TMainForm.LeftDockPanelUnDock(Sender:

TObject; Client: TControl; NewTarget: TWinControl;

var Allow: Boolean); begin

if (Sender as TPanel).DockClientCount = 1 then ShowDockPanel(Sender as TPanel, False, nil); end;

procedure TMainForm.LeftDockPanelGetSitelnfо(Sender: TObject; DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);

begin

CanDock:=DockClient is TDockableForm; end;

procedure TMainForm.BottomDockPanelDockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer;

State: TDragState; var Accept: Boolean); var ARect: TRect;

begin

Accept := Source.Control is TDockableForm;

if Accept then begin

ARect.TopLeft := BottomDockPanel.ClientToScreen(

Point(0, -Self.ClientHeight div 3)); ARect.BottomRight:=BottomDockPanel.ClientToScreen(

Point(BottomDockPanel.Width, BottomDockPanel.Height)); Source.DockRect := ARect;

end;

end;

end.

Для основной формы установлено свойство DockSite=false. Для двух расположенных на ней панелей (TPanel) и CoolBar1 установлено Dock-Site=true. Таким образом, "причаливание" клиентов TDockableForm разрешено к двум панелям. К компоненту TCoolBar также разрешено "при­чаливание". Используются при этом стандартные методы. Тип форм-

190

клиентов, которые могут быть пристыкованы к основной форме, описан во втором модуле uDockForm.

unit uDockForm; interface

uses Windows, Messages, SysUtils, Classes, Graphics,

Controls, Forms, Dialogs, Menus, ExtCtrls, StdCtrls; type

TDockableForm = class(TForm) Memo1: TMemo;

procedure FormDockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean);

procedure FormClose(Sender: TObject;

var Action: TCloseAction); private

function ComputeDockingRect(var DockRect: TRect;

MousePos: TPoint): TAlign; end;

implementation {$R *.dfm}

uses ComCtrls, uMain;

procedure TDockableForm.FormDockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState;

var Accept: Boolean); var .ARect: TRect;

begin

Accept := (Source.Control is TDockableForm);

if Accept and (ComputeDockingRect(ARect,Point(X, 7)) <> alNone) then Source.DockRect := ARect;

end;

function TDockableForm.ComputeDockingRect(var DockRect:

TRect; MousePos: TPoint): TAlign;

var DockTopRect, DockLeftRect, DockBottomRect,

DockRightRect, DockCenterRect: TRect; begin

Result := alNone;

DockLeftReet.TopLeft := Point(0, 0) ; DockLeftRect.BottomRight := Point(ClientWidth div 5,

ClientHeight);

DockTopRect.TopLeft := Point(ClientWidth div 5, 0); DockTopRect.BottomRight := Point(

ClientWidth div 5*4, ClientHeight div 5); DockRightRect.TopLeft := Point(ClientWidth div 5*4, 0); ' DockRightRect.BottomRight:=Point(ClientWidth, ClientHeight); DockBottomRect.TopLeft := Point(ClientWidth div 5,

ClientHeight div 5 * 4);

DockBottomRect.BottomRight := Point(ClientWidth div 5*4,

191

ClientHeight);

DockCenterRect.TopLeft : = Point(ClientWidth div 5,

4,

ClientHeight div 5);

DockCenterRect.BottomRight := Point(ClientWidth div

ClientHeight div 5 * 4);

if PtInRect(DockLeftRect, MousePos) then begin

Result := alLeft;

DockRect := DockLeftRect;

DockRect.Right := ClientWidth div 2;

end else

if PtInRect(DockTopRect, MousePos) then begin

Result := alTop;

DockRect := DockTopRect;

DockRect.Left := 0;

DockRect.Right := ClientWidth;

DockRect.Bottom := ClientHeight div 2;

end else

if PtInRect(DockRightRect, MousePos) then begin

Result := alRight;

DockRect := DockRightRect;

DockRect.Left : = ClientWidth div 2;

end else

if PtInRect(DockBottomRect, MousePos) then begin

Result := alBottom;

DockRect := DockBottomRect;

DockRect.Left := 0;

DockRect.Right := ClientWidth;

DockRecb.Top := ClientHeight div 2;

end else

if PtInRect(DockCenterRect, MousePos) then begin Result := alClient; DockRect := DockCenterRect; end;

if Result = alNone then Exit;

DockRect.TopLeft := ClxentToScreen(DockRect.TopLeft); DockRect.BottomRight:=ClientToScreen(DockRect.BottomRxght);

end;

procedure TDockablePorm.PormClose(Sender: TObject;

var Action: TCloseAction);

begin

Action := caHide;

end;

end.

Модуль uDockForm определяет форму, для которой установлено: Dock-Site=true, DragKind=DkDock, DragMode=dmAutomatic, т.е. данная форма может быть как клиентом, так и доком. Важную функцию выполняет под­программа ComputeDockingRect, которая позволяет вычислить возможный

192

вариант (по позиции курсора мыши) и прямоугольник пристыковки клиента. Можно попытаться изменить используемые в этой функции константы при расчете прямоугольника пристыковки. Приводятся 5 возможных вариантов, которые применяются для форм типа TDockableForm. Функция ptlnRect проверяет предоставляемый доком прямоугольник и проводит вычисления, необходимые для пристыковывания клиента. Второй вариант выполнения примера приводится на рис. 54, на котором показано, что используются пла­вающие панели инструментов.

Рис. 54

В примере использовалось несколько новых компонентов. Как можно заметить, в частности (см. рис. 53), одновременно было применено меню и две инструментальные панели с кнопками.

Практика показала, что для построения панелей инструментов удобно использовать специальные компоненты ТToolBar и ТCoolBar, находящиеся на странице Win32 палитры компонентов. Эти компоненты имеют большое разнообразие возможностей, свойств и методов. В данном случае ТСооШаг используется как контейнер, на котором расположены две инструменталь­ные панели со специальными кнопками TToolButton. Кроме кнопок, на па­нель ТТооШаг можно помещать комбинированные списки, быстрые кнопки SpeedButton, редакторы Edit и другие элементы. Для добавления новой

193

кнопки нужно щелкнуть на панели правой кнопкой мыши и выбрать пункт New Button.

Так как инструментальные кнопки и пункты меню дублируют друг друга в работе, для синхронизации управляющих элементов был использован ком­понент TActionList. Нажатием правой кнопки мыши на компоненте, распо­ложенном на форме, вызывается специальный редактор Action List Editor, который позволяет набрать нужное количество объектов действий Action типа Taction (рис. 55, категории ViewWindows (а) и ViewToolBars (б)).

Рис. 55

Все объекты Action группируются в категории, число которых можно выбирать произвольно или равным числу пунктов в линейке меню. На рис. 55 не показано, что пункт "Выход" входит в состав категории (No Category).

Очевидно, с каждым совпадающим по своему действию пунктом меню и инструментальной кнопкой должен работать один и тот же обработчик со­бытий. Дальнейшая настройка действий Action выполняется с помощью ин­спектора объектов (рис. 56, 57).

Образцы настройки свойств и событий для всех кнопок показаны на рис. 56 (показан выбор свойств (а) и событий (б) для кнопки Yellow). Естествен­но, вначале необходимо с помощью свойства Name присвоить всем кнопкам имена (на рис. 56 это не показано). Следует обратить внимание на то, что вместо события OnClick для пунктов меню настраивается событие On-Execute, используемое для действий Acton. Среда Delphi автоматически подставляет для события OnClick пункта меню (см. рис. 56, б) то же самое событие, что устанавлено программистом для события OnExecute.

Последняя операция заключается в согласовании действий элемента Ас-tionList1 и меню MainMenu1. Данное согласование также проводят, исполь­зуя инспектор объектов. На рис. 57 показан выбор свойств (а) и событий (б) для пункта меню Yellowl. Имена всех пунктов меню и инструментальных кнопок можно найти в тексте программы примера 24.

a) 6)

Рис. 57

В примере использовался еще один новый элемент TSplitter. Этот ком­понент служит для формирования окна, разделенного плавающими граница­ми на несколько зон. Сами компоненты TSplitter при этом остаются невиди­мыми. В данном случае было применено два таких элемента на нижней гра­нице и слева от основной формы (там, где на рис. 53 пристыкованы клиенты) для того, чтобы пристыкованные клиенты не уходили за пределы границ окна-дока.

Теперь, рассмотрим более сложные варианты технологии Drag and Drop с использованием нестандартных подходов, в частности, такого инструмен­та, как DockManager. Для этого нам понадобятся упоминавшиеся выше два модуля. Кроме того, необходимо немного изменить второй модуль uDockForm.

Необходимо обратить внимание на то, что построение форм conjoin-DockHost и TabDockHost осуществляется в процессе выполнения приложе­ния. Поэтому в программе-проекте нужно убрать строки автоматического построения этих форм, которые появятся после подключения к проекту до­полнительных модулей. Далее приводится текст программы второго модуля,

194

195

в котором опущено описание метода ComputeDockingRect (приводится выше).

unit uDockForm;

interface

uses Windows, Messages, SysUtils, Classes, Graphics,

Controls, Forms, Dialogs, Menus, ExtCtrls, StdCtrls; type

TDockableForm = class(TForm) Memo1: TMemo;

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

State: TDragState; var Accept: Boolean); procedure FormClose(Sender: TObject;

var Action: TCloseAction); private

function ComputeDockingRect(var DockRect: TRect;

MousePos: TPoint): TAlign; procedure CMDockclient(var Message:

TCMDockClient); message CM_DOCKCLIENT; end;

implementation {$R *.dfm}

uses ComCtrls, uTabHost, uConjoinHost, uMain; procedure TDockableForm.FormDockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean);

var ARect: TRect;

begin

Accept := (Source.Control is TDockableForm);

if Accept and (ComputeDockingRect(ARect, Point(X, Y))

<> alNone) then Source.DockRect := ARect; end; 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);

196

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).PageControll,

nil, alClient);

Message.DockSource.Control.ManualDock( TTabDockHost(Host).PageControll, 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 один из двух объявленных в модулях uCon-joinHost и uTabHost новых доков и после дополнительных проверок пыта­ется пристыковать клиентов с помощью нестандартных методов к этим до­кам. Может быть построено несколько таких доков. Один вариант формы-дока (форма-контейнер) объявлен в модуле, который приводится ниже.

unit uConjoinHost; interface

uses Windows, Messages, SysUtils, Classes, Graphics,

197

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;

198

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;

199

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;

implementation

{$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;

end.

200

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

Рис. 59

Рис. 60

В заключение отметим использование функции ManualDock, которая может организовать технологию Drag and Dock в случаях отсутствия необ­ходимых установок для двух стыкующихся элементов. В частности, в моду­ле uDockForm выполняется операция стыковки между основной формой и клиентом при условии, что клиент запрашивает и получает прямоугольник "причаливания" в центре основной формы (задано программно: alClient в процедуре CMDockClient). Результат такой операции представлен на рис. 60.

201

Окно в данном случае потеряло свои стандартные кнопки и стало не­управляемым с помощью мыши. Чтобы вернуть этому окну управление, как предусмотрено в приложении, необходимо обеспечить стыковку с ним еще одного клиента. В зависимости от варианта второй стыковки может быть получен один из двух случаев, представленных на рис. 58 и 59, которые по­лучаются при обработке полученной операции с помощью похожих обра­ботчиков, находящихся в модуле TConjoinDockHost (FormUnDock) и моду­ле TTabDockHost (PageControllUnDock).

ИСПОЛЬЗОВАНИЕ ФУНКЦИЙ WINDOWS API ПРИ РАБОТЕ