diff --git a/.gitattributes b/.gitattributes index f06fa2e0be..140e554c38 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/examples/anchordocking/dockform1unit.pas b/examples/anchordocking/dockform1unit.pas index e9dcfa8e4d..2502e31187 100644 --- a/examples/anchordocking/dockform1unit.pas +++ b/examples/anchordocking/dockform1unit.pas @@ -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); diff --git a/ide/buildlazdialog.lfm b/ide/buildlazdialog.lfm new file mode 100644 index 0000000000..588c2c183b --- /dev/null +++ b/ide/buildlazdialog.lfm @@ -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 diff --git a/ide/buildlazdialog.lrs b/ide/buildlazdialog.lrs new file mode 100644 index 0000000000..2f4724f398 --- /dev/null +++ b/ide/buildlazdialog.lrs @@ -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 +]); diff --git a/lcl/controls.pp b/lcl/controls.pp index b0da5a0eb2..1470f8fa8c 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -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; diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc index af1b31b1bc..5361aa3ea1 100644 --- a/lcl/include/customform.inc +++ b/lcl/include/customform.inc @@ -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; diff --git a/lcl/ldockctrl.pas b/lcl/ldockctrl.pas index c615feb96b..314f77831d 100644 --- a/lcl/ldockctrl.pas +++ b/lcl/ldockctrl.pas @@ -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. diff --git a/lcl/ldocktree.pas b/lcl/ldocktree.pas index b7558b9382..bc8c2c2309 100644 --- a/lcl/ldocktree.pas +++ b/lcl/ldocktree.pas @@ -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