Property DragMode: TDragMode, где

Type TDragMode = (dmManual, dmAutomatic);

Значение dmAutomatic обеспечивает автоматическую реакцию компонента на нажатие левой кнопки мыши – механизм перетаскивания включается самостоятельно. Значение dmManual (установлено по умолчанию) требует от разработчика обеспечить включение специфических действий при перетаскивании.

Для инициализации переноса в источнике используется метод BeginDrag (если не включено dmAutomatic), который можно включить, например, в обработчике OnMouseDown. Приемником может стать любой компонент, для которого создан обработчик события OnDragOver. Этот обработчик вызывается при достижении курсором мыши компонента-приемника. Окончание переноса фиксируется работой обработчика OnDragDrop, в котором можно выполнить некоторые действия в приемнике. Определенные действия предусмотрены и в источнике с помощью обработчика OnEndDrag, после того как он получит сообщение об окончании операции переноса. Следует отметить, что не любые действия возможны к реализации.

 

ПРИМЕР 23

 

Рассмотрим пример по использованию Drag and Drop. В программе ниже представлены почти все выше указанные виды обработчиков событий по реализации данного интерфейса.

unit Prim23;

Interface

uses Windows, Messages, SysUtils, Variants,

Classes,Graphics, Controls, Forms,

Dialogs, ExtCtrls, StdCtrls, Buttons;

Type

TForm1 = class(TForm)

Edit1: TEdit;

Edit2: TEdit;

Panel1: TPanel;

Panel2: TPanel;

Button1: TButton;

BitBtn1: TBitBtn;

procedure Edit1MouseDown (Sender: TObject; Button:

TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure Edit2DragOver (Sender, Source: TObject;

X, Y: Integer; State: TDragState;

var Accept: Boolean);

procedure Edit2DragDrop (Sender, Source: TObject;

X, Y: Integer);

procedure Edit1EndDrag (Sender, Target: TObject;

X, Y: Integer);

procedure FormDragOver (Sender, Source: TObject;

X, Y: Integer;State: TDragState;

var Accept: Boolean);

procedure FormDragDrop (Sender, Source: TObject;

X, Y: Integer);

procedure Panel1DragOver (Sender, Source: TObject;

X, Y: Integer; State: TDragState;

var Accept: Boolean);

procedure Panel1DragDrop (Sender, Source: TObject;

X, Y: Integer);

end;

var Form1: TForm1;

Implementation

{$R *.dfm}

procedure TForm1.Edit1MouseDown (Sender: TObject;

Button: TMouseButton;Shift: TShiftState;

X, Y: Integer);

begin

if Button=mbLeft then TEdit(Sender).BeginDrag(true);

end;

procedure TForm1.Edit2DragOver (Sender,Source: TObject;

X, Y: Integer; State: TDragState;

var Accept: Boolean);

begin

if Source is TEdit then Accept:=true

else Accept:=false;

end;

procedure TForm1.Edit2DragDrop (Sender,Source: TObject;

X, Y: Integer);

begin

TEdit(Sender).Text:=TEdit(Source).Text;

TEdit(Sender).SetFocus;

TEdit(Sender).SelectAll;

end;

procedure TForm1.Edit1EndDrag (Sender, Target: TObject;

X, Y: Integer);

begin

if Assigned(Target) then TEdit(Sender).Text:=

'Текст перенесен в '+TEdit(Target).Name;

end;

procedure TForm1.FormDragOver (Sender, Source: TObject;

X, Y: Integer; State: TDragState;

var Accept: Boolean);

begin

if (Source.ClassName='TPanel') or

(Source.ClassName='TButton') then Accept:=true

else Accept:=false;

end;

procedure TForm1.FormDragDrop (Sender, Source: TObject;

X, Y: Integer);

begin

TControl(Source).Left:=x;

TControl(Source).Top:=y;

end;

procedure TForm1.Panel1DragOver (Sender,Source:

TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

begin

if Source is TButton then Accept:=true

else Accept:=false;

end;

procedure TForm1.Panel1DragDrop (Sender, Source:

TObject; X, Y: Integer);

begin

if Source is TButton then begin

TButton(Source).Left:=(Sender as TPanel).Left+x;

TButton(Source).Top:=(Sender as TPanel).Top+y;

if Source is TBitBtn then begin

TBitBtn(Source).Width:=147;

TBitBtn(Source).Caption:='На форму нельзя';

if Application.MessageBox(PChar('Выход'),

PChar('Выбор варианта'),MB_DEFBUTTON1 +

MB_ICONEXCLAMATION + MB_OKCANCEL) = IDOK

then close;

end;

end;

end;

End.

В обработчике Panel1DragDrop как и в Panel1DragOver учитывается, что TBitBtn является вариантом TButton. Если рассматривать форму, то все представленные на ней элементы являются наследниками класса TControl, поэтому в обработчике FormDragDrop не конкретизируются разрешенные к перемещению компоненты. При преобразовании типов объектов использовались две конструкции, например, TButton(Source) или Source as TButton что по результату означает одно и то же. На рис. 51 представлена форма данного примера.

 

Рис. 51 Форма примера 23.

Для элементов Edit1, Edit2 и Panel1 (“приемник”) установлено значение DragMode = dmManual, для остальных элементов DragMode = dmAutomatic. Вариант выполнения переноса Drag and Drop представлен на рис 52. Можно выделить изменение “поведения” кнопки BitBtn1. Она потеряла заданную функцию Close. Для выхода из программы (если не пользоваться стандартным способом закрытия окна) предусмотрен специальный диалог, вызываемый при перемещении данной кнопки.

 

Рис. 52 Вариант решения примера 23.

 

ТЕХНОЛОГИЯ DRAG AND DOCK

 

Данная технология реализует динамическое перетаскивание мышью и прицепление одного объекта к другому. В данном механизме участвуют два элемента: один – док (docking site) – может принимать объекты, другой – клиент (dockable control) – присоединяемый компонент. Delphi наделяет данной технологией потомков классов TWinControl и TControl. Класс объекта, играющий роль дока, должен быть производным от класса TWinControl,а класс стыкуемого объекта – от Tcontrol (или TWinControl).

Если рассматривать свойства компонентов, то доком может быть любой объект, обладающий свойством DockSite типа Boolean. Объекты-доки должны быть способны выступать по отношению к другим объектам в качестве контейнеров. Что касается стыкуемых элементов, то подходящие для них компоненты должны иметь два свойства DragKind и DragMode. Как и в случае с технологией перетаскивания Drag and Drop возможны два варианта реализации механизма Drag and Dock, задаваемые в свойстве DragMode: dmManual и dmAutomatic. В свойстве DragKind необходимо задать dkDock.

Иногда в данной технологии бывает полезным свойство AutoSize. Когда оба свойства дока DockSite и AutoSize имеют значение true, док (если это не форма) во время выполнения программы не виден до тех пор, пока к нему не будет пристыкован хотя бы один клиент. Таким поведением часто наделяются компоненты TPanel, которые в этом случае имеют нулевое значение для одного из измерений (высоты или ширины).

Программист для управления данной технологией может воспользоваться рядом обработчиков событий. Реакцию клиента на события, возникающие в моменты начала и конца переноса, можно задавать в обработчиках OnStartDock и OnEndDock. Во время переноса можно управлять процессом с помощью следующего ряда подключаемых к доку обработчиков: OnGetSiteInfo, OnDockOver, OnDockDrop, OnUnDock. Событие OnGetSiteInfo используется для некоторых компонентов, например, для TPanel. Данное событие в самом начале процесса перетаскивания рассылает сообщения и параметры клиента всем потенциальным докам (у которых свойство DockSite установлено в true) В ответ док должен сообщить решение о приеме клиента и предоставить прямоугольник приема в случае положительного варианта. Два события OnDockOver и OnDockDrop в точности соответствуют своим аналогам из технологии Drag and Drop. В обработчике OnUnDock можно запрограммировать некоторые действия в момент покидания дока и “приземления” клиента в другом месте.

Следует отметить, что реализация технологии Drag and Dock намного сложнее, чем реализация Drag and Drop. В частности, перед стыковкой необходимо вычислять возможный прямоугольник приема. В модуле uDockForm приводится такая функция (ComputeDockingRect). Кроме того, в некоторых сложных вариантах при установке у дока свойства UseDockManager в true возможно использование менеджера контроля докинга (свойство DockManager), с помощью которого определяется прямоугольник BoundsRect как быстрый способ получения контроля клиента на доке. Данный менеджер реализует интерфейс IDockManager, имеющий множество возможностей настройки поведения дока. Пристыкованный элемент может быть перемещен в другую позицию при помощи методов ManualDock, ManualFloat, Dock или можно воспользоваться (для некоторых типов клиентов) свойством FloatingDockSiteClass, устанавливая его значение в CustomDockForm.

 

ПРИМЕР 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);