1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Types, Forms, Controls, Dialogs, Menus, ExtCtrls,
{LDockTree,} HelpIntfs, LazHelpHTML;
type
{ TForm1 }
TForm1 = class(TForm)
HTMLBrowserHelpViewer1: THTMLBrowserHelpViewer;
HTMLHelpDatabase1: THTMLHelpDatabase;
MainMenu1: TMainMenu;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
procedure FormDockOver(Sender: TObject; Source: TDragDockObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
procedure MenuItem1Click(Sender: TObject);
procedure MenuItem2Click(Sender: TObject);
private
FIndex: Integer;
function NextIndex: String;
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R unit1.lfm}
{ TForm1 }
procedure TForm1.MenuItem1Click(Sender: TObject);
var
F: TForm;
Idx: String;
begin
F := TForm.Create(Application);
with F do
begin
DragKind := dkDock;
DragMode := dmAutomatic;
Idx := NextIndex;
Caption := 'New Form ' + Idx;
Name := 'DockForm' + Idx;
with TPanel.Create(F) do
begin
Parent := F;
Align := alClient;
Caption := F.Caption;
end;
Show;
end;
end;
procedure TForm1.MenuItem2Click(Sender: TObject);
var
FileName, err: String;
begin
FileName := ExtractFilePath(ParamStr(0))+'1.html';
TDockTree(DockManager).DumpLayout(FileName);
// how to open it in a cross-platform way?
err := '';
if HelpIntfs.ShowHelp('file:///' + FileName, 'Dock Layout', 'text/html', err) <> shrSuccess then
ShowMessage(err);
end;
procedure TForm1.FormDockOver(Sender: TObject; Source: TDragDockObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
function RectToScreen(R: TRect): TRect;
begin
Result.TopLeft := ClientToScreen(R.TopLeft);
Result.BottomRight := ClientToScreen(R.BottomRight);
end;
var
ChopWidth, ChopHeight: Integer;
Pt: TPoint;
R: TRect;
begin
Accept := True;
ChopWidth := ClientWidth div 3;
ChopHeight := ClientHeight div 3;
Pt := Point(X, Y);
R := Rect(0, 0, ChopWidth, ClientHeight);
if PtInRect(R, Pt) then
begin
Source.DockRect := RectToScreen(R);
Exit;
end;
R := Rect(0, 0, ClientWidth, ChopHeight);
if PtInRect(R, Pt) then
begin
Source.DockRect := RectToScreen(R);
Exit;
end;
R := Rect(ClientWidth - ChopWidth, 0, ClientWidth, ClientHeight);
if PtInRect(R, Pt) then
begin
Source.DockRect := RectToScreen(R);
Exit;
end;
R := Rect(0, ClientHeight - ChopHeight, ClientWidth, ClientHeight);
if PtInRect(R, Pt) then
begin
Source.DockRect := RectToScreen(R);
Exit;
end;
R := Rect(0, 0, ClientWidth, ClientHeight);
Source.DockRect := RectToScreen(R);
end;
function TForm1.NextIndex: String;
begin
Result := IntToStr(FIndex);
inc(FIndex);
end;
end.
|
