Пример 24
Данный пример демонстрирует некоторые возможности технологии перетаскивания элементов или форм на другие формы или элементы. Он представлен четырьмя модулями. Основной модуль (uMain) содержит форму основного дока, которая строится в процессе запуска приложения. Модуль (uDockForm) содержит объявление формы-клиента, на которой расположен один компонент TMemo. При желании можно ввести некоторый текст в этом редакторе. Формы-клиенты строятся при создании основной формы. Предусмотрено построение сразу семи форм, отличающихся цветом. Первоначально все эти семь форм невидимы.
Остальные два модуля, как и основная форма, содержат объявления форм-доков: В модуле uConjoinHost объявляется простая форма, а в uTabHost - форма, содержащая компонент TpageControl, т.е. форма в виде записной книжки, состоящей первоначально из одной страницы. Все формы имеют соответствующие заголовки для простоты их распознавания.
Вначале рассмотрим простой вариант данного примера без применения модулей uConjoinHost и uTabHost и соответствующих дополнительных форм На рис. 53 демонстрируется общий интерфейс примера и основная форма с пристыкованными к ней двумя формами-клиентами. Формы-клиенты пристыкованы не непосредственно на основную форму, а при помощи двух компонентов TPanel.
Рис. 53 Вариант 1 решения примера 24.
Ниже приводится программный код основного модуля.
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;
BottomDockPanel: TPanel;
VSplitter: TSplitter;
HSplitter: TSplitter;
MainMenu1: TMainMenu;
File2: TMenuItem;
Exit2: TMenuItem;
View2: TMenuItem;
ToolBar21: TMenuItem;
ToolBar11: TMenuItem;
Yellow1: TMenuItem;
Blue1: TMenuItem;
Green1: TMenuItem;
Lime1: TMenuItem;
Purple1: TMenuItem;
Red1: TMenuItem;
Teal1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure ViewToolBar1Execute(Sender: TObject);
procedure ViewToolBar2Execute(Sender: TObject);
procedure ExitActionExecute(Sender: TObject);
procedure ViewClientWindowExecute(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 LeftDockPanelUnDock(Sender: TObject;
Client: TControl; NewTarget: TWinControl;
var Allow: Boolean);
procedure LeftDockPanelGetSiteInfo(Sender: TObject;
DockClient: TControl; var InfluenceRect:
TRect; MousePos: TPoint; var CanDock: Boolean);
procedure BottomDockPanelDockOver(Sender: TObject;
Source: TDragDockObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
public
procedure ShowDockPanel(APanel: TPanel;
MakeVisible: Boolean; Client: TControl);
end;
var MainForm: TMainForm;
implementation
{uses uTabHost, uConjoinHost;}
{$R *.dfm}
const
Colors: array [0..6] of TColor = (clYellow, clBlue,
clGreen, clRed, clTeal, clPurple, clLime);
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
ToolBar11.Checked := not ToolBar11.Checked;
btnToolBar1.Down := ToolBar11.Checked;
if ToolBar1.Floating then
ToolBar1.HostDockSite.Visible := ToolBar11.Checked
else
ToolBar1.Visible := ToolBar11.Checked;
end;
procedure TMainForm.ViewToolBar2Execute(Sender:
TObject);
begin
ToolBar21.Checked := not ToolBar21.Checked;
btnToolBar2.Down := ToolBar21.Checked;
if ToolBar2.Floating then
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
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.LeftDockPanelGetSiteInfo(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 установлено DockSite=true. Таким образом, “причаливание” клиентов TDockableForm разрешено к двум панелям. К компоненту TCoolBar также разрешено “причаливание”. Используются при этом стандартные методы. Тип форм-клиентов, которые могут быть пристыкованы к основной форме, описан во втором модуле 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, Y)) <> 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;
DockLeftRect.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, ClientHeight);
DockCenterRect.TopLeft := Point(ClientWidth div 5,
ClientHeight div 5);
DockCenterRect.BottomRight := Point(
ClientWidth div 5 * 4, 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;
DockRect.Top := ClientHeight div 2;
end else
if PtInRect(DockCenterRect, MousePos) then begin
Result := alClient;
DockRect := DockCenterRect;
end;
if Result = alNone then Exit;
DockRect.TopLeft := ClientToScreen(DockRect.TopLeft);
DockRect.BottomRight := ClientToScreen(
DockRect.BottomRight);
end;
procedure TDockableForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action := caHide;
end;
end.
Модуль uDockForm определяет форму-клиент, для которой установлено: DockSite=true, DragKind=DkDock, DragMode=dmAutomatic, - т.е. данная форма может быть как клиентом, так и доком. Важную функцию выполняет подпрограмма ComputeDockingRect, которая позволяет вычислить возможный вариант (по позиции курсора мыши) и прямоугольник пристыковки клиента. Можно попытаться изменить используемые в этой функции константы при расчете прямоугольника пристыковки. Приводятся 5 возможных вариантов, которые применяются для форм типа TDockableForm. Функция PtInRect проверяет предоставляемый доком прямоугольник и проводит вычисления, необходимые для пристыковывания клиента. Второй вариант выполнения примера приводится на рис. 54, на котором показано, что используются плавающие панели инструментов.
Рис. 54 Вариант 2 решения примера 24.
В примере использовалось несколько новых компонентов. Как можно заметить, в частности (рис. 53), одновременно было применено меню и две инструментальные панели с кнопками.
Практика показала, что для построения панелей инструментов удобно использовать специальные компоненты TToolBar и TCoolBar, находящиеся на странице Win32 палитры компонентов. Эти компоненты имеют большое разнообразие возможностей, свойств и методов. В данном случае TCoolBar используется как контейнер, на котором расположены две инструментальные панели со специальными кнопками TToolButton. Кроме кнопок, на панель TToolBar можно помещать комбинированные списки, быстрые кнопки SpeedButton, редакторы Edit и др. элементы. Для добавления новой кнопки нужно щелкнуть на панели правой кнопкой мыши и выбрать пункт New Button.
Так как инструментальные кнопки и пункты меню дублируют друг друга в работе, для синхронизации управляющих элементов был использован компонент TActionList. Нажатием правой кнопки мыши на компоненте, расположенном на форме, вызывается специальный редактор Action List Editor, который позволяет набрать нужное количество объектов действий Action типа Taction (рис. 55).
а) |
б) |
Рис. 55 Выбор действий и категорий ( а) – категория ViewWindows; б) – категория ViewToolBars).
Все объекты Action группируются в категории, количество которых может выбираться произвольно или столько, сколько пунктов в линейке меню. На рис 55 не показано, что пункт “Выход” входит в состав категории (No Category).
Очевидно, с каждым совпадающем по своему действию пунктом меню и инструментальной кнопкой должен работать один и тот же обработчик событий. Кроме того, могут одновременно применяться и просто командные кнопки или другие управляющие элементы, работу которых также можно согласовать с помощью компонента TActionList. Дальнейшая настройка действий Action выполняется с помощью инспектора объектов (рис. 56, 57).
|
|
а)
б)Рис. 56 Выбор свойств (а) и событий (б) для кнопки Yellow.
Образец настройки свойств и событий для всех кнопок показан на рис. 56. Естественно, вначале необходимо с помощью свойства Name присвоить всем кнопкам имена (на рис. 56 это не показано). Следует обратить внимание на то, что вместо события OnClick для пунктов меню настраивается событие OnExecute, используемое для действий Acton. Среда Delphi автоматически подставляет для события OnClick пункта меню (рис. 56 б) то же самое событие, что устанавлено программистом для события OnExecute.
Последняя операция заключается в согласовании действий элемента ActionList1 и меню MainMenu1. Данное согласование также проводится, используя инспектор объектов (рис. 57). Имена всех пунктов меню и инструментальных кнопок можно найти в тексте программы примера 24.
а) |
б) |
Рис. 57 Выбор свойств (а) и событий (б) для пункта меню Yellow1.
В примере использовался еще один новый элемент TSplitter. Этот компонент служит для формирования окна, разделенного плавающими границами на несколько зон. Сами компоненты TSplitter при этом остаются невидимыми. В данном случае было применено два таких элемента на нижней границе и слева основной формы (там, где на рис. 53 пристыкованы клиенты) для того, чтобы пристыкованные клиенты не уходили за пределы границ окна-дока.
Теперь рассмотрим более сложные варианты технологии Drag and Drop с использованием нестандартных подходов, в частности, такого инструмента, как DockManager. Для этого нам понадобятся упоминавшиеся выше два модуля. Кроме того, необходимо немного изменить второй модуль uDockForm.
Необходимо обратить внимание на то, что построение форм ConjoinDockHost и TabDockHost осуществляется в процессе выполнения приложения. Поэтому в программе-проекте нужно убрать строки автоматического построения этих форм, которые появятся после подключения к проекту дополнительных модулей. Далее приводится текст программы второго модуля, в котором опущено описание метода ComputeDockingRect (приводится выше).
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;
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);
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.