Project DOCKTEST
Project Structure
DOCKTEST.DPR
program DockTest;
uses
Forms,
DockForm in 'DockForm.pas' {Form1},
DockHost in 'DockHost.pas' {Form2};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
DOCKFORM.PAS
unit DockForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Menus;
type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Button2: TButton;
Button3: TButton;
Memo1: TMemo;
Splitter1: TSplitter;
PopupMenu1: TPopupMenu;
DocktoPanel1: TMenuItem;
DocktoForm1: TMenuItem;
Floating1: TMenuItem;
Splitter2: TSplitter;
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure Panel1DockDrop(Sender: TObject; Source: TDragDockObject; X,
Y: Integer);
procedure ControlStartDock(Sender: TObject;
var DragObject: TDragDockObject);
procedure Panel1DockOver(Sender: TObject; Source: TDragDockObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
procedure DocktoPanel1Click(Sender: TObject);
procedure DocktoForm1Click(Sender: TObject);
procedure Floating1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
DockFileName: string;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
DockHost;
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
FileStr: TFileStream;
begin
// Panel1.DockOrientation := doHorizontal;
Memo1.FloatingDockSiteClass := TForm2;
ListBox1.FloatingDockSiteClass := TCustomDockForm;
// relaod the settings
DockFileName := ExtractFilePath (Application.Exename) +
'dock.dck';
if FileExists (DockFileName) then
begin
FileStr := TFileStream.Create (DockFileName, fmOpenRead);
try
Panel1.DockManager.LoadFromStream (FileStr);
finally
FileStr.Free;
end;
end;
Panel1.DockManager.ResetBounds (True);
end;
procedure TForm1.Panel1DockDrop(Sender: TObject; Source: TDragDockObject;
X, Y: Integer);
begin
Caption := 'Docked: ' + IntToStr (Panel1.DockClientCount);
end;
procedure TForm1.ControlStartDock(Sender: TObject;
var DragObject: TDragDockObject);
begin
Caption := 'Docking ' + (Sender as TComponent).Name;
end;
procedure TForm1.Panel1DockOver(Sender: TObject; Source: TDragDockObject;
X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
Caption := 'Docking: ' + Source.Control.Name;
Accept := True;
end;
procedure TForm1.DocktoPanel1Click(Sender: TObject);
begin
// dock to the panel
ListBox1.ManualDock (Panel1, Panel1, alBottom);
end;
procedure TForm1.DocktoForm1Click(Sender: TObject);
begin
// dock to the current form
ListBox1.Dock (Self, Rect (200, 100, 100, 100));
end;
procedure TForm1.Floating1Click(Sender: TObject);
begin
// toggle the floating status
if ListBox1.Floating then
ListBox1.ManualDock (Panel1, Panel1, alBottom)
else
ListBox1.ManualFloat (Rect (100, 100, 200, 300));
Floating1.Checked := ListBox1.Floating;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
FileStr: TFileStream;
begin
if Panel1.DockClientCount > 0 then
begin
FileStr := TFileStream.Create (DockFileName,
fmCreate or fmOpenWrite);
try
Panel1.DockManager.SaveToStream (FileStr);
finally
FileStr.Free;
end;
end
else
// remove the file
DeleteFile (DockFileName);
end;
end.
DOCKHOST.PAS
unit DockHost;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TForm2 = class(TForm)
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDockDrop(Sender: TObject; Source: TDragDockObject; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
uses DockForm;
{$R *.DFM}
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if DockClientCount > 0 then
DockClients [0].ManualDock (Form1.Panel1);
end;
procedure TForm2.FormDockDrop(Sender: TObject; Source: TDragDockObject; X,
Y: Integer);
begin
Show;
end;
end.
DOCKFORM.DFM
object Form1: TForm1
Left = 188
Top = 107
Width = 474
Height = 480
Caption = 'DockTest'
Color = clBtnFace
UseDockManager = True
DragKind = dkDock
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Splitter1: TSplitter
Left = 129
Top = 0
Width = 3
Height = 453
Cursor = crHSplit
end
object Splitter2: TSplitter
Left = 132
Top = 0
Width = 3
Height = 453
Cursor = crHSplit
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 129
Height = 453
Align = alLeft
BorderWidth = 1
DockSite = True
DragKind = dkDock
TabOrder = 0
OnDockDrop = Panel1DockDrop
OnDockOver = Panel1DockOver
end
object Panel2: TPanel
Left = 136
Top = 0
Width = 329
Height = 41
DragKind = dkDock
DragMode = dmAutomatic
TabOrder = 1
OnStartDock = ControlStartDock
object Button2: TButton
Left = 16
Top = 8
Width = 75
Height = 25
Caption = 'Button2'
TabOrder = 0
end
object Button3: TButton
Left = 96
Top = 8
Width = 75
Height = 25
Caption = 'Button3'
TabOrder = 1
end
end
object Memo1: TMemo
Left = 0
Top = 340
Width = 465
Height = 113
DragKind = dkDock
DragMode = dmAutomatic
Lines.Strings = (
'Memo1')
TabOrder = 2
OnStartDock = ControlStartDock
end
object ListBox1: TListBox
Left = 136
Top = 40
Width = 329
Height = 297
DragKind = dkDock
DragMode = dmAutomatic
ItemHeight = 13
Items.Strings = (
'one'
'two'
'three')
PopupMenu = PopupMenu1
TabOrder = 3
OnStartDock = ControlStartDock
end
object PopupMenu1: TPopupMenu
Left = 400
Top = 152
object DocktoPanel1: TMenuItem
Caption = 'Dock to Panel'
OnClick = DocktoPanel1Click
end
object DocktoForm1: TMenuItem
Caption = 'Dock to Form'
OnClick = DocktoForm1Click
end
object Floating1: TMenuItem
Caption = 'Floating'
OnClick = Floating1Click
end
end
end
DOCKHOST.DFM
object Form2: TForm2
Left = 636
Top = 220
Width = 194
Height = 190
BorderStyle = bsSizeToolWin
Caption = 'Form2'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnDockDrop = FormDockDrop
PixelsPerInch = 96
TextHeight = 13
end
|