paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-01 21:20:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

anchordocking: implemented saving layout

Browse Source 
git-svn-id: trunk@9000 -
This commit is contained in:
mattias 2006-03-22 23:18:04 +00:00
parent 2a2a3e1ba5
commit 0b48164f48
9 changed files with 714 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -990,6 +990,8 @@ ide/bigidemake.cfg svneol=native#text/plain
ide/buildfiledlg.lfm svneol=native#text/plain
ide/buildfiledlg.lrs svneol=native#text/pascal
ide/buildfiledlg.pas svneol=native#text/pascal
ide/buildlazdialog.lfm svneol=native#text/plain
ide/buildlazdialog.lrs svneol=native#text/plain
ide/buildlazdialog.pas svneol=native#text/pascal
ide/charactermapdlg.lfm svneol=native#text/plain
ide/charactermapdlg.lrs svneol=native#text/pascal

25
examples/anchordocking/dockform1unit.pas
View File

@ -5,7 +5,7 @@ unit DockForm1Unit;
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
DockForm2Unit, Buttons, Menus, LDockCtrl;
type
@ -22,7 +22,7 @@ type
private
function CreateNewForm: TCustomForm;
public
Docker: TLazControlDocker;
DockerForm1: TLazControlDocker;
DockingManager: TLazDockingManager;
end;
@ -40,10 +40,15 @@ begin
end;
function TMainForm.CreateNewForm: TCustomForm;
var
DockForm: TDockFormX;
begin
Result:=TDockFormX.Create(Self);
TDockFormX(Result).Docker.Manager:=DockingManager;
TDockFormX(Result).Caption:=TDockFormX(Result).Docker.DockerName;
DockForm:=TDockFormX.Create(Self);
Result:=DockForm;
DockForm.Docker.Manager:=DockingManager;
DockForm.Name:=DockForm.Docker.DockerName;
DockForm.Docker.Name:='Docker'+DockForm.Name;
DebugLn('TMainForm.CreateNewForm ',DockForm.Name,' ',DockingManager.FindDockerByControl(DockForm,nil).DockerName,' ',DockingManager.GetControlConfigName(DockForm));
end;
procedure TMainForm.CreateNewFormButtonClick(Sender: TObject);
@ -59,14 +64,20 @@ var
begin
if Sender=nil then ;
DockingManager:=TLazDockingManager.Create(Self);
Docker:=TLazControlDocker.Create(Self);
Docker.Manager:=DockingManager;
DockerForm1:=TLazControlDocker.Create(Self);
DockerForm1.Name:='DockerForm1';
DockerForm1.Manager:=DockingManager;
Form2:=CreateNewForm;
DockingManager.Manager.InsertControl(Form2,alLeft,Self);
Form3:=CreateNewForm;
DockingManager.Manager.InsertControl(Form3,alBottom,Self);
DockingManager.WriteDebugReport;
DockerForm1.GetLayoutFromControl;
DockerForm1.WriteConfigTreeDebugReport;
end;
procedure TMainForm.FormDestroy(Sender: TObject);

246
ide/buildlazdialog.lfm Normal file
View File

@ -0,0 +1,246 @@
object ConfigureBuildLazarusDlg: TConfigureBuildLazarusDlg
ActiveControl = BuildAllButton
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsToolWindow
Caption = 'ConfigureBuildLazarusDlg'
ClientHeight = 478
ClientWidth = 479
OnCreate = FormCreate
PixelsPerInch = 112
Position = poScreenCenter
HorzScrollBar.Page = 478
VertScrollBar.Page = 477
Left = 459
Height = 478
Top = 300
Width = 479
object OptionsLabel: TLabel
Caption = 'Options:'
Color = clNone
ParentColor = False
Left = 10
Height = 13
Top = 282
Width = 47
end
object TargetOSLabel: TLabel
Caption = 'Target OS:'
Color = clNone
ParentColor = False
Left = 10
Height = 13
Top = 311
Width = 61
end
object TargetDirectoryLabel: TLabel
Caption = 'Target Directory:'
Color = clNone
ParentColor = False
Left = 10
Height = 13
Top = 341
Width = 94
end
object TargetCPULabel: TLabel
Caption = 'Target CPU'
Color = clNone
ParentColor = False
Left = 10
Height = 13
Top = 373
Width = 65
end
object BuildAllButton: TButton
BorderSpacing.InnerBorder = 2
Caption = 'Set to "Build All"'
OnClick = BuildAllButtonClick
TabOrder = 0
Left = 10
Height = 25
Top = 12
Width = 194
end
object CleanAllCheckBox: TCheckBox
Caption = 'Clean All'
TabOrder = 1
Left = 317
Height = 24
Top = 12
Width = 79
end
object OptionsEdit: TEdit
TabOrder = 5
Left = 156
Height = 23
Top = 282
Width = 310
end
object TargetOSEdit: TEdit
TabOrder = 6
Left = 156
Height = 23
Top = 311
Width = 310
end
object TargetDirectoryComboBox: TComboBox
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
MaxLength = 0
TabOrder = 7
Left = 156
Height = 25
Top = 341
Width = 286
end
object TargetDirectoryButton: TButton
BorderSpacing.InnerBorder = 2
Caption = '...'
OnClick = TargetDirectoryButtonClick
TabOrder = 8
Left = 444
Height = 25
Top = 341
Width = 22
end
object LCLInterfaceRadioGroup: TRadioGroup
AutoFill = True
Caption = 'LCLInterfaceRadioGroup'
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
TabOrder = 3
Left = 317
Height = 206
Top = 42
Width = 149
end
object WithStaticPackagesCheckBox: TCheckBox
Caption = 'WithStaticPackagesCheckBox'
TabOrder = 4
Left = 317
Height = 24
Top = 252
Width = 194
end
object RestartAfterBuildCheckBox: TCheckBox
Caption = 'RestartAfterBuildCheckBox'
TabOrder = 10
Left = 10
Height = 24
Top = 408
Width = 176
end
object ConfirmBuildCheckBox: TCheckBox
Caption = 'ConfirmBuildCheckBox'
TabOrder = 11
Left = 10
Height = 24
Top = 434
Width = 154
end
object OKButton: TButton
BorderSpacing.InnerBorder = 2
Caption = 'OK'
OnClick = OKButtonClick
TabOrder = 12
Left = 282
Height = 25
Top = 433
Width = 75
end
object CancelButton: TButton
BorderSpacing.InnerBorder = 2
Caption = 'Cancel'
OnClick = CancelButtonClick
TabOrder = 13
Left = 391
Height = 25
Top = 433
Width = 75
end
object ItemsListBox: TListBox
ItemHeight = 25
OnDrawItem = ItemsListBoxDrawItem
OnMouseDown = ItemsListBoxMouseDown
Style = lbOwnerDrawFixed
TabOrder = 2
TopIndex = -1
Left = 10
Height = 234
Top = 42
Width = 284
end
object TargetCPUComboBox: TComboBox
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
MaxLength = 0
TabOrder = 9
Left = 156
Height = 25
Top = 373
Width = 286
end
object ImageList: TImageList
Height = 20
Width = 20
left = 12
top = 216
Bitmap = {
6C69030000001400000014000000C60100002F2A2058504D202A2F0A73746174
69632063686172202A206D656E755F737465706F7665725F78706D5B5D203D20
7B0A22313620313620352031222C0A22200963204E6F6E65222C0A222E096320
23303030303030222C0A222B09632023303030303833222C0A22400963202346
4646464646222C0A222309632023383338353833222C0A2220202020202E2020
2E20202020202020222C0A2220202E20202020202020202E20202020222C0A22
20202020202020202020202020202020222C0A222E2020202020202020202020
202E2020222C0A2220202020202020202020202020202020222C0A2220202020
202020202020202E2E2E2E2E222C0A222020202020202020202020202E2E2E20
222C0A22202020202020202020202020202E2020222C0A22202020202B2B2B2B
2B2B2B2020202020222C0A22202020202B40404040402B2320202020222C0A22
202020202B40404040402B2320202020222C0A22202020202B40404040402B23
20202020222C0A22202020202B40404040402B2320202020222C0A2220202020
2B40404040402B2320202020222C0A22202020202B2B2B2B2B2B2B2320202020
222C0A2220202020202323232323232320202020227D3B0A740200002F2A2058
504D202A2F0A7374617469632063686172202A207468726561645F78706D5B5D
203D207B0A2231362031362031372031222C0A22200963204E6F6E65222C0A22
2E09632023464638304646222C0A222B09632023383438343030222C0A224009
632023383438343834222C0A222309632023433643364336222C0A2224096320
23464646463030222C0A222509632023464646464646222C0A22260963202346
4646464646222C0A222A09632023464646464646222C0A223D09632023464646
464646222C0A222D09632023464646464646222C0A223B096320234646464646
46222C0A223E09632023464646464646222C0A222C0963202346464646464622
2C0A222709632023464646464646222C0A222909632023464646464646222C0A
222109632023303030303030222C0A2220202020202020202020202020202020
222C0A2220202020202020202020202020202020222C0A222020202020202020
2020202020202020222C0A2220202020202B2B2B2B20202020202020222C0A22
2020202B2B2124212B21212020202020222C0A222020202B24242424242B2120
20202020222C0A2220202B2B242B212B2421212120202020222C0A2220202B24
2421402124242B2120202020222C0A2220202B2B242B212B2421212120202020
222C0A222020402B24242424242B212120202020222C0A22202020402B212421
2B21212020202020222C0A2220202020402121212120202020202020222C0A22
20202020202020202020202020202020222C0A22202020202020202020202020
20202020222C0A2220202020202020202020202020202020222C0A2220202020
202020202020202020202020227D3B0A270200002F2A2058504D202A2F0A7374
617469632063686172202A20616C6C5F78706D5B5D203D207B0A223136203136
2031322031222C0A22200963204E6F6E65222C0A222E09632023354133393030
222C0A222B09632023363334413138222C0A224009632023303030303030222C
0A222309632023464642443441222C0A222409632023464641443030222C0A22
2509632023423537333030222C0A222609632023393436333030222C0A222A09
632023364234413030222C0A223D09632023383438343834222C0A222D096320
23464644363843222C0A223B09632023444539343030222C0A222020202E2E2E
2B202020202020202020222C0A22202E2E4023402E404020202020202020222C
0A22202E2324242424254020202020202020222C0A222B2E242640262E2E2E2B
202020202020222C0A222E2324402E2E4023402E404020202020222C0A222E25
24262E2324242424254020202020222C0A222A25242B2E242640262E2E2E2B20
2020222C0A22202A252E2324402E2E4023402E404020222C0A2220202A2E2524
262E2324242424254020222C0A222020202A25242B2E2426402624404040222C
0A22202020202A252E2324403D402D3B2540222C0A2220202020202A2E252426
402D3B404040222C0A222020202020202A2524242D3B3B254040222C0A222020
20202020202A25403B4025404020222C0A2220202020202020202A4040404020
2020222C0A2220202020202020202020202020202020227D3B0A0A
}
end
end

88
ide/buildlazdialog.lrs Normal file
View File

@ -0,0 +1,88 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TConfigureBuildLazarusDlg','FORMDATA',[
'TPF0'#25'TConfigureBuildLazarusDlg'#24'ConfigureBuildLazarusDlg'#13'ActiveCo'
+'ntrol'#7#14'BuildAllButton'#11'BorderIcons'#11#12'biSystemMenu'#10'biMinimi'
+'ze'#0#11'BorderStyle'#7#12'bsToolWindow'#7'Caption'#6#24'ConfigureBuildLaza'
+'rusDlg'#12'ClientHeight'#3#222#1#11'ClientWidth'#3#223#1#8'OnCreate'#7#10'F'
+'ormCreate'#13'PixelsPerInch'#2'p'#8'Position'#7#14'poScreenCenter'#18'HorzS'
+'crollBar.Page'#3#222#1#18'VertScrollBar.Page'#3#221#1#4'Left'#3#203#1#6'Hei'
+'ght'#3#222#1#3'Top'#3','#1#5'Width'#3#223#1#0#6'TLabel'#12'OptionsLabel'#7
+'Caption'#6#8'Options:'#5'Color'#7#6'clNone'#11'ParentColor'#8#4'Left'#2#10#6
+'Height'#2#13#3'Top'#3#26#1#5'Width'#2'/'#0#0#6'TLabel'#13'TargetOSLabel'#7
+'Caption'#6#10'Target OS:'#5'Color'#7#6'clNone'#11'ParentColor'#8#4'Left'#2
+#10#6'Height'#2#13#3'Top'#3'7'#1#5'Width'#2'='#0#0#6'TLabel'#20'TargetDirect'
+'oryLabel'#7'Caption'#6#17'Target Directory:'#5'Color'#7#6'clNone'#11'Parent'
+'Color'#8#4'Left'#2#10#6'Height'#2#13#3'Top'#3'U'#1#5'Width'#2'^'#0#0#6'TLab'
+'el'#14'TargetCPULabel'#7'Caption'#6#10'Target CPU'#5'Color'#7#6'clNone'#11
+'ParentColor'#8#4'Left'#2#10#6'Height'#2#13#3'Top'#3'u'#1#5'Width'#2'A'#0#0#7
+'TButton'#14'BuildAllButton'#25'BorderSpacing.InnerBorder'#2#2#7'Caption'#6
+#18'Set to "Build All"'#7'OnClick'#7#19'BuildAllButtonClick'#8'TabOrder'#2#0
+#4'Left'#2#10#6'Height'#2#25#3'Top'#2#12#5'Width'#3#194#0#0#0#9'TCheckBox'#16
+'CleanAllCheckBox'#7'Caption'#6#9'Clean All'#8'TabOrder'#2#1#4'Left'#3'='#1#6
+'Height'#2#24#3'Top'#2#12#5'Width'#2'O'#0#0#5'TEdit'#11'OptionsEdit'#8'TabOr'
+'der'#2#5#4'Left'#3#156#0#6'Height'#2#23#3'Top'#3#26#1#5'Width'#3'6'#1#0#0#5
+'TEdit'#12'TargetOSEdit'#8'TabOrder'#2#6#4'Left'#3#156#0#6'Height'#2#23#3'To'
+'p'#3'7'#1#5'Width'#3'6'#1#0#0#9'TComboBox'#23'TargetDirectoryComboBox'#16'A'
+'utoCompleteText'#11#22'cbactEndOfLineComplete'#20'cbactSearchAscending'#0#9
+'MaxLength'#2#0#8'TabOrder'#2#7#4'Left'#3#156#0#6'Height'#2#25#3'Top'#3'U'#1
+#5'Width'#3#30#1#0#0#7'TButton'#21'TargetDirectoryButton'#25'BorderSpacing.I'
+'nnerBorder'#2#2#7'Caption'#6#3'...'#7'OnClick'#7#26'TargetDirectoryButtonCl'
+'ick'#8'TabOrder'#2#8#4'Left'#3#188#1#6'Height'#2#25#3'Top'#3'U'#1#5'Width'#2
+#22#0#0#11'TRadioGroup'#22'LCLInterfaceRadioGroup'#8'AutoFill'#9#7'Caption'#6
+#22'LCLInterfaceRadioGroup'#28'ChildSizing.LeftRightSpacing'#2#6#28'ChildSiz'
+'ing.TopBottomSpacing'#2#6#29'ChildSizing.EnlargeHorizontal'#7#24'crsHomogen'
+'ousChildResize'#27'ChildSizing.EnlargeVertical'#7#24'crsHomogenousChildResi'
+'ze'#28'ChildSizing.ShrinkHorizontal'#7#14'crsScaleChilds'#26'ChildSizing.Sh'
+'rinkVertical'#7#14'crsScaleChilds'#18'ChildSizing.Layout'#7#29'cclLeftToRig'
+'htThenTopToBottom'#27'ChildSizing.ControlsPerLine'#2#1#8'TabOrder'#2#3#4'Le'
+'ft'#3'='#1#6'Height'#3#206#0#3'Top'#2'*'#5'Width'#3#149#0#0#0#9'TCheckBox'
+#26'WithStaticPackagesCheckBox'#7'Caption'#6#26'WithStaticPackagesCheckBox'#8
+'TabOrder'#2#4#4'Left'#3'='#1#6'Height'#2#24#3'Top'#3#252#0#5'Width'#3#194#0
+#0#0#9'TCheckBox'#25'RestartAfterBuildCheckBox'#7'Caption'#6#25'RestartAfter'
+'BuildCheckBox'#8'TabOrder'#2#10#4'Left'#2#10#6'Height'#2#24#3'Top'#3#152#1#5
+'Width'#3#176#0#0#0#9'TCheckBox'#20'ConfirmBuildCheckBox'#7'Caption'#6#20'Co'
+'nfirmBuildCheckBox'#8'TabOrder'#2#11#4'Left'#2#10#6'Height'#2#24#3'Top'#3
+#178#1#5'Width'#3#154#0#0#0#7'TButton'#8'OKButton'#25'BorderSpacing.InnerBor'
+'der'#2#2#7'Caption'#6#2'OK'#7'OnClick'#7#13'OKButtonClick'#8'TabOrder'#2#12
+#4'Left'#3#26#1#6'Height'#2#25#3'Top'#3#177#1#5'Width'#2'K'#0#0#7'TButton'#12
+'CancelButton'#25'BorderSpacing.InnerBorder'#2#2#7'Caption'#6#6'Cancel'#7'On'
+'Click'#7#17'CancelButtonClick'#8'TabOrder'#2#13#4'Left'#3#135#1#6'Height'#2
+#25#3'Top'#3#177#1#5'Width'#2'K'#0#0#8'TListBox'#12'ItemsListBox'#10'ItemHei'
+'ght'#2#25#10'OnDrawItem'#7#20'ItemsListBoxDrawItem'#11'OnMouseDown'#7#21'It'
+'emsListBoxMouseDown'#5'Style'#7#16'lbOwnerDrawFixed'#8'TabOrder'#2#2#8'TopI'
+'ndex'#2#255#4'Left'#2#10#6'Height'#3#234#0#3'Top'#2'*'#5'Width'#3#28#1#0#0#9
+'TComboBox'#17'TargetCPUComboBox'#16'AutoCompleteText'#11#22'cbactEndOfLineC'
+'omplete'#20'cbactSearchAscending'#0#9'MaxLength'#2#0#8'TabOrder'#2#9#4'Left'
+#3#156#0#6'Height'#2#25#3'Top'#3'u'#1#5'Width'#3#30#1#0#0#10'TImageList'#9'I'
+'mageList'#6'Height'#2#20#5'Width'#2#20#4'left'#2#12#3'top'#3#216#0#6'Bitmap'
+#10'{'#6#0#0'li'#3#0#0#0#20#0#0#0#20#0#0#0#198#1#0#0'/* XPM */'#10'static ch'
+'ar * menu_stepover_xpm[] = {'#10'"16 16 5 1",'#10'" '#9'c None",'#10'".'#9
+'c #000000",'#10'"+'#9'c #000083",'#10'"@'#9'c #FFFFFF",'#10'"#'#9'c #838583'
+'",'#10'" . . ",'#10'" . . ",'#10'" ",'
+#10'". . ",'#10'" ",'#10'" .....",'#10
+'" ... ",'#10'" . ",'#10'" +++++++ ",'#10'" '
+' +@@@@@+# ",'#10'" +@@@@@+# ",'#10'" +@@@@@+# ",'#10'" +'
+'@@@@@+# ",'#10'" +@@@@@+# ",'#10'" +++++++# ",'#10'" ###'
+'#### "};'#10't'#2#0#0'/* XPM */'#10'static char * thread_xpm[] = {'#10'"'
,'16 16 17 1",'#10'" '#9'c None",'#10'".'#9'c #FF80FF",'#10'"+'#9'c #848400",'
+#10'"@'#9'c #848484",'#10'"#'#9'c #C6C6C6",'#10'"$'#9'c #FFFF00",'#10'"%'#9
+'c #FFFFFF",'#10'"&'#9'c #FFFFFF",'#10'"*'#9'c #FFFFFF",'#10'"='#9'c #FFFFFF'
+'",'#10'"-'#9'c #FFFFFF",'#10'";'#9'c #FFFFFF",'#10'">'#9'c #FFFFFF",'#10'",'
+#9'c #FFFFFF",'#10'"'''#9'c #FFFFFF",'#10'")'#9'c #FFFFFF",'#10'"!'#9'c #000'
+'000",'#10'" ",'#10'" ",'#10'" '
+'",'#10'" ++++ ",'#10'" ++!$!+!! ",'#10'" +$$$$$+! ",'
+#10'" ++$+!+$!!! ",'#10'" +$$!@!$$+! ",'#10'" ++$+!+$!!! ",'#10
+'" @+$$$$$+!! ",'#10'" @+!$!+!! ",'#10'" @!!!! ",'#10'" '
+' ",'#10'" ",'#10'" ",'#10'" '
+' "};'#10''''#2#0#0'/* XPM */'#10'static char * all_xpm[] = {'#10
+'"16 16 12 1",'#10'" '#9'c None",'#10'".'#9'c #5A3900",'#10'"+'#9'c #634A18"'
+','#10'"@'#9'c #000000",'#10'"#'#9'c #FFBD4A",'#10'"$'#9'c #FFAD00",'#10'"%'
+#9'c #B57300",'#10'"&'#9'c #946300",'#10'"*'#9'c #6B4A00",'#10'"='#9'c #8484'
+'84",'#10'"-'#9'c #FFD68C",'#10'";'#9'c #DE9400",'#10'" ...+ ",'#10
+'" ..@#@.@@ ",'#10'" .#$$$$%@ ",'#10'"+.$&@&...+ ",'#10'".#'
+'$@..@#@.@@ ",'#10'".%$&.#$$$$%@ ",'#10'"*%$+.$&@&...+ ",'#10'" *%.#'
+'$@..@#@.@@ ",'#10'" *.%$&.#$$$$%@ ",'#10'" *%$+.$&@&$@@@",'#10'" *%.#'
+'$@=@-;%@",'#10'" *.%$&@-;@@@",'#10'" *%$$-;;%@@",'#10'" *%@;'
+'@%@@ ",'#10'" *@@@@ ",'#10'" "};'#10#10#0#0#0
]);

2
lcl/controls.pp
View File

@ -1708,7 +1708,7 @@ type
function GetTextLen: Integer; override;
procedure Invalidate; override;
procedure InsertControl(AControl: TControl);
procedure InsertControl(AControl: TControl; Index: integer);
procedure InsertControl(AControl: TControl; Index: integer); virtual;
procedure RemoveControl(AControl: TControl);
procedure Repaint; override;
Procedure SetFocus; virtual;

10
lcl/include/customform.inc
View File

@ -1368,9 +1368,9 @@ begin
end;
{------------------------------------------------------------------------------}
{ TCustomForm Method Close }
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------
TCustomForm Method Close
------------------------------------------------------------------------------}
Procedure TCustomForm.Close;
var
CloseAction: TCloseAction;
@ -1393,7 +1393,9 @@ begin
DoClose(CloseAction);
if CloseAction <> caNone then begin
//DebugLn('TCustomForm.Close C ',DbgSName(Self),' ',dbgs(ord(CloseAction)));
if Application.MainForm = Self then Application.Terminate
if (Application.MainForm = Self)
or (Self.IsParentOf(Application.MainForm)) then
Application.Terminate
else if CloseAction = caHide then Hide
else if CloseAction = caMinimize then WindowState := wsMinimized
else Release;

234
lcl/ldockctrl.pas
View File

@ -22,7 +22,12 @@
Author: Mattias Gaertner
Abstract:
This unit contains visual components for docking.
This unit contains visual components for docking and streaming.
ToDo:
- restoring layout, when a docked control becomes visible
- save TLazDockConfigNode to stream
- load TLazDockConfigNode from stream
}
unit LDockCtrl;
@ -31,12 +36,26 @@ unit LDockCtrl;
interface
uses
Classes, SysUtils, LCLProc, Controls, Forms, Menus, LCLStrConsts,
LDockCtrlEdit, LDockTree;
Classes, SysUtils, TypInfo, LCLProc, Controls, Forms, Menus, LCLStrConsts,
StringHashList, LDockCtrlEdit, LDockTree;
type
TNonDockConfigNames = (
ndcnControlName, // '-Name ' + AControl.Name
ndcnChildIndex, // '-ID ' + IntToStr(AControl index in Parent) + AControl.ClassName
ndcnParent // '-Parent' : AControl.Parent
);
const
NonDockConfigNamePrefixes: array[TNonDockConfigNames] of string = (
'-Name ',
'-ID ',
'-Parent');
type
TLDConfigNodeType = (
ldcntControl,
ldcntForm,
ldcntSplitter,
ldcntPages,
ldcntPage
@ -44,7 +63,7 @@ type
{ TLazDockConfigNode }
TLazDockConfigNode = class
TLazDockConfigNode = class(TPersistent)
private
FBounds: TRect;
FName: string;
@ -60,10 +79,13 @@ type
procedure SetParent(const AValue: TLazDockConfigNode);
procedure SetSides(Side: TAnchorKind; const AValue: TLazDockConfigNode);
procedure SetTheType(const AValue: TLDConfigNodeType);
procedure DoAdd(ChildNode: TLazDockConfigNode);
procedure DoRemove(ChildNode: TLazDockConfigNode);
public
constructor Create(const AName: string);
constructor Create(ParentNode: TLazDockConfigNode; const AName: string);
destructor Destroy; override;
procedure Clear;
function FindByName(const AName: string): TLazDockConfigNode;
public
property TheType: TLDConfigNodeType read FTheType write SetTheType;
property Name: string read FName write SetName;
@ -71,7 +93,7 @@ type
property Parent: TLazDockConfigNode read FParent write SetParent;
property Sides[Side: TAnchorKind]: TLazDockConfigNode read GetSides write SetSides;
property ChildCount: Integer read GetChildCount;
property Childs[Index: integer]: TLazDockConfigNode read GetChilds;
property Childs[Index: integer]: TLazDockConfigNode read GetChilds; default;
end;
TCustomLazControlDocker = class;
@ -98,6 +120,7 @@ type
Ignore: TCustomLazControlDocker): string;
procedure SaveToStream(Stream: TStream);
function GetControlConfigName(AControl: TControl): string;
procedure WriteDebugReport;
public
property Manager: TAnchoredDockManager read FManager;
property DockerCount: Integer read GetDockerCount;
@ -110,12 +133,16 @@ type
published
end;
{ TCustomLazControlDocker - a component to mark a form for the TLazDockingManager }
{ TCustomLazControlDocker
A component to connect a form to the TLazDockingManager.
When the control gets visible TCustomLazControlDocker restores the layout.
Before the control gets invisible, TCustomLazControlDocker saves the layout.
}
TCustomLazControlDocker = class(TComponent)
private
FConfigRootNode: TLazDockConfigNode;
FConfigSelfNode: TLazDockConfigNode;
FConfigRootNode: TLazDockConfigNode;// the root node of the config tree
FConfigSelfNode: TLazDockConfigNode;// the node of 'Control'
FControl: TControl;
FDockerName: string;
FExtendPopupMenu: boolean;
@ -131,13 +158,15 @@ type
protected
procedure UpdatePopupMenu; virtual;
procedure Loaded; override;
procedure ShowDockingEditor; virtual;
function GetLocalizedName: string;
procedure ControlVisibleChanging(Sender: TObject);
procedure ControlVisibleChanged(Sender: TObject);
procedure GetLayoutFromControl;
procedure ClearConfigNodes;
public
procedure ShowDockingEditor; virtual;
procedure ClearConfigNodes;
procedure GetLayoutFromControl;
function GetControlName(AControl: TControl): string;
procedure WriteConfigTreeDebugReport;
constructor Create(TheOwner: TComponent); override;
property Control: TControl read FControl write SetControl;
property Manager: TCustomLazDockingManager read FManager write SetManager;
@ -314,7 +343,7 @@ begin
GetLayoutFromControl;
end else begin
// the control will become visible -> dock it to restore the last layout
RaiseGDBException('TCustomLazControlDocker.ControlVisibleChanging TODO restore layout');
end;
end;
@ -323,21 +352,94 @@ begin
end;
function TCustomLazControlDocker.GetControlName(AControl: TControl): string;
var
i: Integer;
begin
Result:=Manager.GetControlConfigName(AControl);
if Result='' then begin
if AControl=Control.Parent then
Result:=NonDockConfigNamePrefixes[ndcnParent]
else if AControl.Name<>'' then
Result:=NonDockConfigNamePrefixes[ndcnControlName]+AControl.Name
else if AControl.Parent<>nil then begin
i:=AControl.Parent.ControlCount-1;
while (i>=0) and (AControl.Parent.Controls[i]<>AControl) do dec(i);
Result:=NonDockConfigNamePrefixes[ndcnChildIndex]+IntToStr(i)
+AControl.ClassName;
end;
end;
end;
procedure TCustomLazControlDocker.GetLayoutFromControl;
function AddNode(AControl: TControl): TLazDockConfigNode;
procedure CopyChildsLayout(ParentNode: TLazDockConfigNode;
ParentNodeControl: TWinControl);
// saves for each child node the names of the anchor side controls
var
i: Integer;
ChildNode: TLazDockConfigNode;
ChildControl: TControl;
a: TAnchorKind;
ChildNames: TStringHashList;// name to control mapping
ChildName: String;
CurAnchorControl: TControl;
CurAnchorCtrlName: String;
CurAnchorNode: TLazDockConfigNode;
begin
ChildNames:=TStringHashList.Create(false);
try
// build mapping of name to control
ChildNames.Data[ParentNode.Name]:=ParentNodeControl;
for i:=0 to ParentNodeControl.ControlCount-1 do begin
ChildControl:=ParentNodeControl.Controls[i];
ChildName:=GetControlName(ChildControl);
if ChildName<>'' then
ChildNames.Data[ChildName]:=ChildControl;
end;
// build mapping control to node
// set 'Sides'
for i:=0 to ParentNode.ChildCount-1 do begin
ChildNode:=ParentNode[i];
ChildControl:=TControl(ChildNames.Data[ChildNode.Name]);
if ChildControl=nil then continue;
for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
CurAnchorControl:=ChildControl.AnchorSide[a].Control;
if CurAnchorControl=nil then continue;
if CurAnchorControl=ParentNodeControl then
CurAnchorNode:=ParentNode
else begin
CurAnchorCtrlName:=GetControlName(CurAnchorControl);
CurAnchorNode:=ParentNode.FindByName(CurAnchorCtrlName);
if CurAnchorNode=nil then
RaiseGDBException('inconsistency');
end;
DebugLn('CopyChildsLayout ',DbgSName(CurAnchorControl),' CurAnchorCtrlName="',CurAnchorCtrlName,'"');
ChildNode.Sides[a]:=CurAnchorNode;
end;
end;
finally
ChildNames.Free;
end;
end;
function AddNode(ParentNode: TLazDockConfigNode;
AControl: TControl): TLazDockConfigNode;
var
i: Integer;
CurChildControl: TControl;
NeedChildNodes: boolean;
begin
Result:=TLazDockConfigNode.Create(Manager.GetControlConfigName(AControl));
Result:=TLazDockConfigNode.Create(ParentNode,GetControlName(AControl));
if AControl=Control then
FConfigSelfNode:=Result;
// The Type
if AControl is TLazDockSplitter then
Result.FTheType:=ldcntSplitter
else if AControl is TLazDockForm then
Result.FTheType:=ldcntForm
else if AControl is TLazDockPages then
Result.FTheType:=ldcntPages
else if AControl is TLazDockPage then
@ -356,7 +458,7 @@ procedure TCustomLazControlDocker.GetLayoutFromControl;
if not NeedChildNodes then begin
for i:=0 to TWinControl(AControl).ControlCount-1 do begin
CurChildControl:=TWinControl(AControl).Controls[i];
if Manager.GetControlConfigName(CurChildControl)<>'' then begin
if Manager.FindDockerByControl(CurChildControl,nil)<>nil then begin
NeedChildNodes:=true;
break;
end;
@ -366,10 +468,12 @@ procedure TCustomLazControlDocker.GetLayoutFromControl;
if NeedChildNodes then begin
for i:=0 to TWinControl(AControl).ControlCount-1 do begin
CurChildControl:=TWinControl(AControl).Controls[i];
AddNode(CurChildControl);
AddNode(Result,CurChildControl);
end;
for i:=0 to Result.ChildCount-1 do begin
end;
end;
CopyChildsLayout(Result,TWinControl(AControl));
end;
end;
@ -380,8 +484,9 @@ begin
if (Control=nil) or (Manager=nil) then exit;
RootControl:=Control;
while RootControl<>nil do RootControl:=RootControl.Parent;
FConfigRootNode:=AddNode(RootControl);
while RootControl.Parent<>nil do
RootControl:=RootControl.Parent;
FConfigRootNode:=AddNode(nil,RootControl);
end;
procedure TCustomLazControlDocker.ClearConfigNodes;
@ -391,6 +496,38 @@ begin
FConfigRootNode:=nil;
end;
procedure TCustomLazControlDocker.WriteConfigTreeDebugReport;
procedure WriteNode(const Prefix: string; ANode: TLazDockConfigNode);
var
a: TAnchorKind;
i: Integer;
s: string;
begin
if ANode=nil then exit;
DbgOut(Prefix,'Name="'+ANode.Name+'"');
DbgOut(' Type=',GetEnumName(TypeInfo(TLDConfigNodeType),ord(ANode.TheType)));
DbgOut(' Bounds='+dbgs(ANode.Bounds));
DbgOut(' Childs='+dbgs(ANode.ChildCount));
for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
if ANode.Sides[a]=nil then continue;
s:=ANode.Sides[a].Name;
if s='' then
s:='?';
DbgOut(' '+AnchorNames[a]+'="'+s+'"');
end;
debugln;
for i:=0 to ANode.ChildCount-1 do begin
WriteNode(Prefix+' ',ANode[i]);
end;
end;
begin
DebugLn('TCustomLazControlDocker.WriteConfigTreeDebugReport '
,' Root=',dbgs(ConfigRootNode),' SelfNode=',dbgs(ConfigSelfNode));
WriteNode(' ',ConfigRootNode);
end;
constructor TCustomLazControlDocker.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
@ -529,7 +666,7 @@ end;
procedure TCustomLazDockingManager.SaveToStream(Stream: TStream);
begin
RaiseGDBException('TODO TCustomLazDockingManager.SaveToStream');
end;
function TCustomLazDockingManager.GetControlConfigName(AControl: TControl
@ -539,9 +676,21 @@ var
begin
Docker:=FindDockerByControl(AControl,nil);
if Docker<>nil then
Result:=Docker.Name
Result:=Docker.DockerName
else
Result:=''
Result:='';
end;
procedure TCustomLazDockingManager.WriteDebugReport;
var
i: Integer;
ADocker: TCustomLazControlDocker;
begin
DebugLn('TCustomLazDockingManager.WriteDebugReport DockerCount=',dbgs(DockerCount));
for i:=0 to DockerCount-1 do begin
ADocker:=Dockers[i];
DebugLn(' ',dbgs(i),' Name="',ADocker.Name,'" DockerName="',ADocker.DockerName,'"');
end;
end;
{ TLazDockConfigNode }
@ -553,7 +702,10 @@ end;
function TLazDockConfigNode.GetChildCount: Integer;
begin
Result:=FChilds.Count;
if FChilds<>nil then
Result:=FChilds.Count
else
Result:=0;
end;
function TLazDockConfigNode.GetChilds(Index: integer): TLazDockConfigNode;
@ -576,7 +728,11 @@ end;
procedure TLazDockConfigNode.SetParent(const AValue: TLazDockConfigNode);
begin
if FParent=AValue then exit;
if FParent<>nil then
FParent.DoRemove(Self);
FParent:=AValue;
if FParent<>nil then
FParent.DoAdd(Self);
end;
procedure TLazDockConfigNode.SetSides(Side: TAnchorKind;
@ -591,10 +747,22 @@ begin
FTheType:=AValue;
end;
constructor TLazDockConfigNode.Create(const AName: string);
procedure TLazDockConfigNode.DoAdd(ChildNode: TLazDockConfigNode);
begin
if FChilds=nil then FChilds:=TFPList.Create;
FChilds.Add(ChildNode);
end;
procedure TLazDockConfigNode.DoRemove(ChildNode: TLazDockConfigNode);
begin
FChilds.Remove(ChildNode);
end;
constructor TLazDockConfigNode.Create(ParentNode: TLazDockConfigNode;
const AName: string);
begin
FName:=AName;
FChilds:=TFPList.Create;
Parent:=ParentNode;
end;
destructor TLazDockConfigNode.Destroy;
@ -609,9 +777,23 @@ procedure TLazDockConfigNode.Clear;
var
i: Integer;
begin
if FChilds=nil then exit;
for i:=ChildCount-1 downto 0 do Childs[i].Free;
FChilds.Clear;
end;
function TLazDockConfigNode.FindByName(const AName: string
): TLazDockConfigNode;
var
i: Integer;
begin
if FChilds<>nil then
for i:=0 to FChilds.Count-1 do begin
Result:=Childs[i];
if CompareText(Result.Name,AName)=0 then exit;
end;
Result:=nil;
end;
end.

152
lcl/ldocktree.pas
View File

@ -82,23 +82,35 @@ type
{ TLazDockForm
The default DockSite for a TLazDockTree
If DockZone is a leaf (DockZone.ChildCount=0) then
Only child control is DockZone.ChildControl
else
if DockZone.Orientation in [doHorizontal,doVertical] then
Child controls are TLazDockForm and TSplitter
else if DockZone.Orientation=doPages then
Child control is a TLazDockPages
Note: AnchorDocking does not use DockZone.
if DockZone<>nil then
If DockZone is a leaf (DockZone.ChildCount=0) then
Only child control is DockZone.ChildControl
else
if DockZone.Orientation in [doHorizontal,doVertical] then
Child controls are TLazDockForm and TSplitter
else if DockZone.Orientation=doPages then
Child control is a TLazDockPages
}
TLazDockForm = class(TCustomForm)
private
FDockZone: TDockZone;
FMainControl: TControl;
FPageControl: TLazDockPages;
procedure SetMainControl(const AValue: TControl);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure InsertControl(AControl: TControl; Index: integer); override;
function CloseQuery: boolean; override;
public
procedure UpdateCaption; virtual;
function FindMainControlCandidate: TControl;
property DockZone: TDockZone read FDockZone;
property PageControl: TLazDockPages read FPageControl;
property MainControl: TControl read FMainControl write SetMainControl;
end;
{ TLazDockPage
@ -1395,6 +1407,130 @@ begin
Result:=Parent as TLazDockPages;
end;
{ TLazDockForm }
procedure TLazDockForm.SetMainControl(const AValue: TControl);
var
NewValue: TControl;
begin
if (AValue<>nil) and (not IsParentOf(AValue)) then
raise Exception.Create('invalid main control');
NewValue:=AValue;
if NewValue=nil then
NewValue:=FindMainControlCandidate;
if FMainControl=NewValue then exit;
FMainControl:=NewValue;
if FMainControl<>nil then
FMainControl.FreeNotification(Self);
UpdateCaption;
end;
procedure TLazDockForm.Notification(AComponent: TComponent;
Operation: TOperation);
begin
if (Operation=opRemove) then begin
if AComponent=FMainControl then
MainControl:=nil;
end;
inherited Notification(AComponent, Operation);
end;
procedure TLazDockForm.InsertControl(AControl: TControl; Index: integer);
var
NewMainConrtrol: TControl;
begin
inherited InsertControl(AControl, Index);
if FMainControl=nil then begin
NewMainConrtrol:=FindMainControlCandidate;
if NewMainConrtrol<>nil then
MainControl:=NewMainConrtrol;
end;
end;
function TLazDockForm.CloseQuery: boolean;
// query all top level forms, if form can close
function QueryForms(ParentControl: TWinControl): boolean;
var
i: Integer;
AControl: TControl;
begin
for i:=0 to ParentControl.ControlCount-1 do begin
AControl:=ParentControl.Controls[i];
if (AControl is TWinControl) then begin
if (AControl is TCustomForm) then begin
// a top level form: query and do not ask childs
if (not TCustomForm(AControl).CloseQuery) then
exit(false);
end
else if not QueryForms(TWinControl(AControl)) then
// search childs for forms
exit(false);
end;
end;
Result:=true;
end;
begin
Result:=inherited CloseQuery;
if Result then
Result:=QueryForms(Self);
end;
procedure TLazDockForm.UpdateCaption;
begin
if FMainControl<>nil then
Caption:=FMainControl.Caption
else
Caption:='';
end;
function TLazDockForm.FindMainControlCandidate: TControl;
var
BestLevel: integer;
procedure FindCandidate(ParentControl: TWinControl; Level: integer);
var
i: Integer;
AControl: TControl;
ResultIsForm, ControlIsForm: boolean;
begin
for i:=0 to ParentControl.ControlCount-1 do begin
AControl:=ParentControl.Controls[i];
if (AControl.Name<>'')
and (not (AControl is TLazDockForm))
and (not (AControl is TLazDockSplitter))
and (not (AControl is TLazDockPages))
and (not (AControl is TLazDockPage))
then begin
// this is a candidate
// prefer forms and top level controls
if (Application<>nil) and (Application.MainForm=AControl) then begin
// the MainForm is the best control
Result:=Application.MainForm;
BestLevel:=-1;
exit;
end;
ResultIsForm:=Result is TCustomForm;
ControlIsForm:=AControl is TCustomForm;
if (Result=nil)
or ((not ResultIsForm) and ControlIsForm)
or ((ResultIsForm=ControlIsForm) and (Level<BestLevel))
then begin
BestLevel:=Level;
Result:=AControl;
end;
end;
if AControl is TWinControl then
FindCandidate(TWinControl(AControl),Level+1);
end;
end;
begin
Result:=nil;
BestLevel:=High(Integer);
FindCandidate(Self,0);
end;
end.

2
lcl/stringhashlist.pas
View File

@ -20,7 +20,7 @@
* *
*****************************************************************************
Thx to Markus Waldenburg.
Thanks to Markus Waldenburg.
}
unit StringHashList;