diff --git a/components/h2pas/h2pasdlg.pas b/components/h2pas/h2pasdlg.pas index 4926c592c6..8907a2ee70 100644 --- a/components/h2pas/h2pasdlg.pas +++ b/components/h2pas/h2pasdlg.pas @@ -62,7 +62,7 @@ type OutputDirBrowseButton: TButton; // convert - PreH2PasEdit: TTTextConvListEditor; + PreH2PasEdit: TTextConvListEditor; ConvertTabSheet: TTabSheet; ConvertButton: TButton; ConvertErrorGroupBox: TGroupBox; @@ -219,7 +219,7 @@ begin SaveSettingsButton.Caption:='&Save Settings'; CloseButton.Caption:='&Close'; - PreH2PasEdit:=TTTextConvListEditor.Create(Self); + PreH2PasEdit:=TTextConvListEditor.Create(Self); with PreH2PasEdit do begin Name:='PreH2PasEdit'; Align:=alTop; diff --git a/components/h2pas/idetextconvlistedit.lfm b/components/h2pas/idetextconvlistedit.lfm index 7c5d9cfd82..c0e916d014 100644 --- a/components/h2pas/idetextconvlistedit.lfm +++ b/components/h2pas/idetextconvlistedit.lfm @@ -1,4 +1,4 @@ -object TTextConvListEditor: TTTextConvListEditor +object TextConvListEditor: TTextConvListEditor Left = 290 Height = 316 Top = 202 @@ -6,7 +6,7 @@ object TTextConvListEditor: TTTextConvListEditor HorzScrollBar.Page = 518 VertScrollBar.Page = 315 ActiveControl = ToolsListBox - Caption = 'TTextConvListEditor' + Caption = 'TextConvListEditor' Constraints.MinHeight = 200 Constraints.MinWidth = 400 OnCreate = FormCreate diff --git a/components/h2pas/idetextconvlistedit.lrs b/components/h2pas/idetextconvlistedit.lrs index a6452b884d..a8ba4214dd 100644 --- a/components/h2pas/idetextconvlistedit.lrs +++ b/components/h2pas/idetextconvlistedit.lrs @@ -1,47 +1,47 @@ { Dies ist eine automatisch erzeugte Lazarus-Ressourcendatei } -LazarusResources.Add('TTTextConvListEditor','FORMDATA',[ - 'TPF0'#20'TTTextConvListEditor'#19'TTextConvListEditor'#4'Left'#3'"'#1#6'Heig' - +'ht'#3'<'#1#3'Top'#3#202#0#5'Width'#3#7#2#18'HorzScrollBar.Page'#3#6#2#18'Ve' - +'rtScrollBar.Page'#3';'#1#13'ActiveControl'#7#12'ToolsListBox'#7'Caption'#6 - +#19'TTextConvListEditor'#21'Constraints.MinHeight'#3#200#0#20'Constraints.Mi' - +'nWidth'#3#144#1#8'OnCreate'#7#10'FormCreate'#0#6'TLabel'#10'ToolsLabel'#4'L' - +'eft'#2#12#6'Height'#2#13#3'Top'#2#9#5'Width'#2'>'#7'Caption'#6#10'ToolsLabe' - +'l'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#8'TListBox'#12'ToolsListBox' - +#21'AnchorSideTop.Control'#7#10'ToolsLabel'#18'AnchorSideTop.Side'#7#9'asrBo' - +'ttom'#23'AnchorSideRight.Control'#7#13'ToolsSplitter'#20'AnchorSideRight.Si' - +'de'#7#9'asrBottom'#24'AnchorSideBottom.Control'#7#14'UpDownSplitter'#21'Anc' - +'horSideBottom.Side'#7#9'asrBottom'#6'Height'#2'}'#3'Top'#2#24#5'Width'#3#236 - +#0#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#17'BorderSpacin' - +'g.Top'#2#2#8'TabOrder'#2#0#8'TopIndex'#2#255#0#0#9'TSplitter'#14'UpDownSpli' - +'tter'#23'AnchorSideRight.Control'#7#5'Owner'#20'AnchorSideRight.Side'#7#9'a' - +'srBottom'#6'Cursor'#7#8'crVSplit'#6'Height'#2#5#3'Top'#3#144#0#5'Width'#3#7 - +#2#5'Align'#7#6'alNone'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#7'Beve' - +'led'#9#12'ResizeAnchor'#7#8'akBottom'#0#0#6'TPanel'#10'ToolsPanel'#22'Ancho' - +'rSideLeft.Control'#7#13'ToolsSplitter'#19'AnchorSideLeft.Side'#7#9'asrBotto' - +'m'#23'AnchorSideRight.Control'#7#5'Owner'#20'AnchorSideRight.Side'#7#9'asrB' - +'ottom'#24'AnchorSideBottom.Control'#7#14'UpDownSplitter'#4'Left'#3#236#0#6 - +'Height'#3#144#0#5'Width'#3#27#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight' - +#8'akBottom'#0#10'BevelOuter'#7#6'bvNone'#7'Caption'#6#10'ToolsPanel'#18'Chi' - +'ldSizing.Layout'#7#29'cclLeftToRightThenTopToBottom'#27'ChildSizing.Control' - +'sPerLine'#2#2#8'TabOrder'#2#1#0#7'TButton'#13'AddToolButton'#6'Height'#2#26 - +#5'Width'#2'x'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#13'AddToolButt' - +'on'#8'TabOrder'#2#0#0#0#7'TButton'#16'DeleteToolButton'#4'Left'#2'x'#6'Heig' - +'ht'#2#26#5'Width'#3#137#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#16 - +'DeleteToolButton'#8'TabOrder'#2#1#0#0#7'TButton'#16'MoveToolUpButton'#6'Hei' - +'ght'#2#26#3'Top'#2#26#5'Width'#2'x'#25'BorderSpacing.InnerBorder'#2#4#7'Cap' - +'tion'#6#16'MoveToolUpButton'#8'TabOrder'#2#2#0#0#7'TButton'#18'MoveToolDown' - +'Button'#4'Left'#2'x'#6'Height'#2#26#3'Top'#2#26#5'Width'#3#137#0#25'BorderS' - +'pacing.InnerBorder'#2#4#7'Caption'#6#18'MoveToolDownButton'#8'TabOrder'#2#3 - +#0#0#7'TButton'#14'CopyToolButton'#6'Height'#2#26#3'Top'#2'4'#5'Width'#2'x' - +#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#14'CopyToolButton'#8'TabOrde' - +'r'#2#4#0#0#7'TButton'#11'PasteButton'#4'Left'#2'x'#6'Height'#2#26#3'Top'#2 - +'4'#5'Width'#3#137#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#11'Paste' - +'Button'#8'TabOrder'#2#5#0#0#7'TButton'#11'CloneButton'#6'Height'#2#26#3'Top' - +#2'N'#5'Width'#2'x'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#11'CloneB' - +'utton'#8'TabOrder'#2#6#0#0#0#9'TSplitter'#13'ToolsSplitter'#21'AnchorSideTo' - +'p.Control'#7#5'Owner'#23'AnchorSideRight.Control'#7#5'Owner'#20'AnchorSideR' - +'ight.Side'#7#9'asrBottom'#24'AnchorSideBottom.Control'#7#14'UpDownSplitter' - +#4'Left'#3#232#0#6'Height'#3#144#0#5'Width'#2#4#5'Align'#7#6'alNone'#7'Ancho' - +'rs'#11#5'akTop'#6'akLeft'#8'akBottom'#0#7'Beveled'#9#0#0#0 +LazarusResources.Add('TTextConvListEditor','FORMDATA',[ + 'TPF0'#19'TTextConvListEditor'#18'TextConvListEditor'#4'Left'#3'"'#1#6'Height' + +#3'<'#1#3'Top'#3#202#0#5'Width'#3#7#2#18'HorzScrollBar.Page'#3#6#2#18'VertSc' + +'rollBar.Page'#3';'#1#13'ActiveControl'#7#12'ToolsListBox'#7'Caption'#6#18'T' + +'extConvListEditor'#21'Constraints.MinHeight'#3#200#0#20'Constraints.MinWidt' + +'h'#3#144#1#8'OnCreate'#7#10'FormCreate'#0#6'TLabel'#10'ToolsLabel'#4'Left'#2 + +#12#6'Height'#2#13#3'Top'#2#9#5'Width'#2'>'#7'Caption'#6#10'ToolsLabel'#5'Co' + +'lor'#7#6'clNone'#11'ParentColor'#8#0#0#8'TListBox'#12'ToolsListBox'#21'Anch' + +'orSideTop.Control'#7#10'ToolsLabel'#18'AnchorSideTop.Side'#7#9'asrBottom'#23 + +'AnchorSideRight.Control'#7#13'ToolsSplitter'#20'AnchorSideRight.Side'#7#9'a' + +'srBottom'#24'AnchorSideBottom.Control'#7#14'UpDownSplitter'#21'AnchorSideBo' + +'ttom.Side'#7#9'asrBottom'#6'Height'#2'}'#3'Top'#2#24#5'Width'#3#236#0#7'Anc' + +'hors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#17'BorderSpacing.Top'#2 + +#2#8'TabOrder'#2#0#8'TopIndex'#2#255#0#0#9'TSplitter'#14'UpDownSplitter'#23 + +'AnchorSideRight.Control'#7#5'Owner'#20'AnchorSideRight.Side'#7#9'asrBottom' + +#6'Cursor'#7#8'crVSplit'#6'Height'#2#5#3'Top'#3#144#0#5'Width'#3#7#2#5'Align' + +#7#6'alNone'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#7'Beveled'#9#12'R' + +'esizeAnchor'#7#8'akBottom'#0#0#6'TPanel'#10'ToolsPanel'#22'AnchorSideLeft.C' + +'ontrol'#7#13'ToolsSplitter'#19'AnchorSideLeft.Side'#7#9'asrBottom'#23'Ancho' + +'rSideRight.Control'#7#5'Owner'#20'AnchorSideRight.Side'#7#9'asrBottom'#24'A' + +'nchorSideBottom.Control'#7#14'UpDownSplitter'#4'Left'#3#236#0#6'Height'#3 + +#144#0#5'Width'#3#27#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBotto' + +'m'#0#10'BevelOuter'#7#6'bvNone'#7'Caption'#6#10'ToolsPanel'#18'ChildSizing.' + +'Layout'#7#29'cclLeftToRightThenTopToBottom'#27'ChildSizing.ControlsPerLine' + +#2#2#8'TabOrder'#2#1#0#7'TButton'#13'AddToolButton'#6'Height'#2#26#5'Width'#2 + +'x'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#13'AddToolButton'#8'TabOr' + +'der'#2#0#0#0#7'TButton'#16'DeleteToolButton'#4'Left'#2'x'#6'Height'#2#26#5 + +'Width'#3#137#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#16'DeleteTool' + +'Button'#8'TabOrder'#2#1#0#0#7'TButton'#16'MoveToolUpButton'#6'Height'#2#26#3 + +'Top'#2#26#5'Width'#2'x'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#16'M' + +'oveToolUpButton'#8'TabOrder'#2#2#0#0#7'TButton'#18'MoveToolDownButton'#4'Le' + +'ft'#2'x'#6'Height'#2#26#3'Top'#2#26#5'Width'#3#137#0#25'BorderSpacing.Inner' + +'Border'#2#4#7'Caption'#6#18'MoveToolDownButton'#8'TabOrder'#2#3#0#0#7'TButt' + +'on'#14'CopyToolButton'#6'Height'#2#26#3'Top'#2'4'#5'Width'#2'x'#25'BorderSp' + +'acing.InnerBorder'#2#4#7'Caption'#6#14'CopyToolButton'#8'TabOrder'#2#4#0#0#7 + +'TButton'#11'PasteButton'#4'Left'#2'x'#6'Height'#2#26#3'Top'#2'4'#5'Width'#3 + +#137#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#11'PasteButton'#8'TabO' + +'rder'#2#5#0#0#7'TButton'#11'CloneButton'#6'Height'#2#26#3'Top'#2'N'#5'Width' + +#2'x'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#11'CloneButton'#8'TabOr' + +'der'#2#6#0#0#0#9'TSplitter'#13'ToolsSplitter'#21'AnchorSideTop.Control'#7#5 + +'Owner'#23'AnchorSideRight.Control'#7#5'Owner'#20'AnchorSideRight.Side'#7#9 + +'asrBottom'#24'AnchorSideBottom.Control'#7#14'UpDownSplitter'#4'Left'#3#232#0 + +#6'Height'#3#144#0#5'Width'#2#4#5'Align'#7#6'alNone'#7'Anchors'#11#5'akTop'#6 + +'akLeft'#8'akBottom'#0#7'Beveled'#9#0#0#0 ]); diff --git a/components/h2pas/idetextconvlistedit.pas b/components/h2pas/idetextconvlistedit.pas index 79485ff040..7d36f68bdf 100644 --- a/components/h2pas/idetextconvlistedit.pas +++ b/components/h2pas/idetextconvlistedit.pas @@ -27,9 +27,9 @@ uses type - { TTTextConvListEditor } + { TTextConvListEditor } - TTTextConvListEditor = class(TForm) + TTextConvListEditor = class(TForm) AddToolButton: TButton; CloneButton: TButton; PasteButton: TButton; @@ -49,13 +49,13 @@ type end; var - TTextConvListEditor: TTTextConvListEditor; + TextConvListEditor: TTextConvListEditor; implementation -{ TTTextConvListEditor } +{ TTextConvListEditor } -procedure TTTextConvListEditor.FormCreate(Sender: TObject); +procedure TTextConvListEditor.FormCreate(Sender: TObject); begin Caption:='Text conversion tools editor'; ToolsLabel.Caption:='Tools:'; diff --git a/ide/main.pp b/ide/main.pp index 3750474506..70ac8b8daa 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -1185,6 +1185,7 @@ begin FreeThenNil(Project1); // free IDE parts + FreeTextConverters; FreeStandardIDEQuickFixItems; FreeFormEditor; FreeAndNil(LazFindReplaceDialog); diff --git a/ide/sourceeditprocs.pas b/ide/sourceeditprocs.pas index c5f0a95eb5..daf0a9e8ba 100644 --- a/ide/sourceeditprocs.pas +++ b/ide/sourceeditprocs.pas @@ -51,6 +51,7 @@ type end; procedure SetupTextConverters; +procedure FreeTextConverters; type TCompletionType = ( @@ -80,6 +81,11 @@ begin TextConverterToolClasses.RegisterClass(TTextReplaceTool); end; +procedure FreeTextConverters; +begin + FreeAndNil(TextConverterToolClasses); +end; + function PaintCompletionItem(const AKey: string; ACanvas: TCanvas; X, Y, MaxX: integer; ItemSelected: boolean; Index: integer; aCompletion : TSynCompletion; CurrentCompletionType: TCompletionType; diff --git a/lcl/avglvltree.pas b/lcl/avglvltree.pas index 6f5dfc4b7b..5250615524 100644 --- a/lcl/avglvltree.pas +++ b/lcl/avglvltree.pas @@ -129,6 +129,81 @@ type end; +type + { TPointerToPointerTree - Associative array } + + TPointerToPointerItem = record + Key: Pointer; + Value: Pointer; + end; + PPointerToPointerItem = ^TPointerToPointerItem; + + TPointerToPointerTree = class + private + FItems: TAvgLvlTree; + function GetCount: Integer; + function GetValues(const Key: Pointer): Pointer; + procedure SetValues(const Key: Pointer; const AValue: Pointer); + function FindNode(const Key: Pointer): TAvgLvlTreeNode; + function GetNode(Node: TAvgLvlTreeNode; out Key, Value: Pointer): Boolean; + public + constructor Create; + destructor Destroy; override; + procedure Clear; + function Contains(const Key: Pointer): Boolean; + function GetFirst(out Key, Value: Pointer): Boolean; + function GetLast(out Key, Value: Pointer): Boolean; + function GetNext(const Key: Pointer; out NextKey, NextValue: Pointer): Boolean; + function GetPrev(const Key: Pointer; out PrevKey, PrevValue: Pointer): Boolean; + property Count: Integer read GetCount; + property Values[const Key: Pointer]: Pointer read GetValues write SetValues; default; + property Tree: TAvgLvlTree read FItems; + end; + + +function ComparePointerToPointerItems(Data1, Data2: Pointer): integer; +function ComparePointerWithPtrToPtrItem(Key, Data: Pointer): Integer; + + +type + { TStringToStringTree - Associative array } + + TStringToStringItem = record + Name: string; + Value: string; + end; + PStringToStringItem = ^TStringToStringItem; + + TStringToStringTree = class + private + FItems: TAvgLvlTree; + fCaseSensitive: Boolean; + function GetCount: Integer; + function GetValues(const Name: string): string; + procedure SetValues(const Name: string; const AValue: string); + function FindNode(const Name: string): TAvgLvlTreeNode; + function GetNode(Node: TAvgLvlTreeNode; out Name, Value: string): Boolean; + public + constructor Create(CaseSensitive: boolean); + destructor Destroy; override; + procedure Clear; + function Contains(const Name: string): Boolean; + procedure Add(const Name, Value, Delimiter: string); + function GetFirst(out Name, Value: string): Boolean; + function GetLast(out Name, Value: string): Boolean; + function GetNext(const Name: string; out NextName, NextValue: string): Boolean; + function GetPrev(const Name: string; out PrevName, PrevValue: string): Boolean; + property Count: Integer read GetCount; + property Values[const Name: string]: string read GetValues write SetValues; default; + property Tree: TAvgLvlTree read FItems; + end; + +function CompareStringToStringItems(Data1, Data2: Pointer): integer; +function CompareStringToStringItemsI(Data1, Data2: Pointer): integer; +function ComparePAnsiStringWithStrToStrItem(Key, Data: Pointer): Integer; +function ComparePAnsiStringWithStrToStrItemI(Key, Data: Pointer): Integer; + + implementation @@ -142,6 +217,40 @@ begin else Result:=0; end; +function ComparePointerToPointerItems(Data1, Data2: Pointer): integer; +begin + Result:=ComparePointer(PPointerToPointerItem(Data1)^.Key, + PPointerToPointerItem(Data2)^.Key); +end; + +function ComparePointerWithPtrToPtrItem(Key, Data: Pointer): Integer; +begin + Result:=ComparePointer(Key,PPointerToPointerItem(Data)^.Key); +end; + +function CompareStringToStringItems(Data1, Data2: Pointer): integer; +begin + Result:=CompareStr(PStringToStringItem(Data1)^.Name, + PStringToStringItem(Data2)^.Name); +end; + +function CompareStringToStringItemsI(Data1, Data2: Pointer): integer; +begin + Result:=CompareText(PStringToStringItem(Data1)^.Name, + PStringToStringItem(Data2)^.Name); +end; + +function ComparePAnsiStringWithStrToStrItem(Key, Data: Pointer): Integer; +begin + Result:=CompareStr(PAnsiString(Key)^,PStringToStringItem(Data)^.Name); +end; + +function ComparePAnsiStringWithStrToStrItemI(Key, Data: Pointer): Integer; +begin + Result:=CompareText(PAnsiString(Key)^,PStringToStringItem(Data)^.Name); +end; + + { TAvgLvlTree } function TAvgLvlTree.Add(Data: Pointer): TAvgLvlTreeNode; @@ -1214,14 +1323,270 @@ begin OldNode.Free; end; +{ TStringToStringTree } + +function TStringToStringTree.GetCount: Integer; +begin + Result:=FItems.Count; +end; + +function TStringToStringTree.GetValues(const Name: string): string; +var + Node: TAvgLvlTreeNode; +begin + Node:=FindNode(Name); + if Node<>nil then + Result:=PStringToStringItem(Node.Data)^.Value + else + Result:=''; +end; + +procedure TStringToStringTree.SetValues(const Name: string; const AValue: string + ); +var + NewItem: PStringToStringItem; + Node: TAvgLvlTreeNode; +begin + Node:=FindNode(Name); + if (Node<>nil) then + PStringToStringItem(Node.Data)^.Value:=AValue + else begin + New(NewItem); + NewItem^.Name:=Name; + NewItem^.Value:=AValue; + FItems.Add(NewItem); + end; +end; + +function TStringToStringTree.FindNode(const Name: string): TAvgLvlTreeNode; +begin + if fCaseSensitive then + Result:=FItems.FindKey(@Name,@ComparePAnsiStringWithStrToStrItem) + else + Result:=FItems.FindKey(@Name,@ComparePAnsiStringWithStrToStrItemI) +end; + +function TStringToStringTree.GetNode(Node: TAvgLvlTreeNode; + out Name, Value: string): Boolean; +var + Item: PStringToStringItem; +begin + if Node<>nil then begin + Item:=PStringToStringItem(Node.Data); + Name:=Item^.Name; + Value:=Item^.Value; + Result:=true; + end else begin + Name:=''; + Value:=''; + Result:=false; + end; +end; + +constructor TStringToStringTree.Create(CaseSensitive: boolean); +begin + fCaseSensitive:=CaseSensitive; + if fCaseSensitive then + FItems:=TAvgLvlTree.Create(@CompareStringToStringItems) + else + FItems:=TAvgLvlTree.Create(@CompareStringToStringItemsI); +end; + +destructor TStringToStringTree.Destroy; +begin + Clear; + FItems.Free; + inherited Destroy; +end; + +procedure TStringToStringTree.Clear; +var + Node: TAvgLvlTreeNode; + Item: PStringToStringItem; +begin + Node:=FItems.FindLowest; + while Node<>nil do begin + Item:=PStringToStringItem(Node.Data); + Dispose(Item); + Node:=FItems.FindSuccessor(Node); + end; + FItems.Clear; +end; + +function TStringToStringTree.Contains(const Name: string): Boolean; +begin + Result:=FindNode(Name)<>nil; +end; + +procedure TStringToStringTree.Add(const Name, Value, Delimiter: string); +var + OldValue: string; +begin + OldValue:=Values[Name]; + if OldValue<>'' then + OldValue:=OldValue+Delimiter; + OldValue:=OldValue+Value; + Values[Name]:=OldValue; +end; + +function TStringToStringTree.GetFirst(out Name, Value: string): Boolean; +begin + Result:=GetNode(Tree.FindLowest,Name,Value); +end; + +function TStringToStringTree.GetLast(out Name, Value: string): Boolean; +begin + Result:=GetNode(Tree.FindHighest,Name,Value); +end; + +function TStringToStringTree.GetNext(const Name: string; out NextName, + NextValue: string): Boolean; +var + Node: TAvgLvlTreeNode; +begin + Node:=FindNode(Name); + if Node<>nil then + Node:=Tree.FindSuccessor(Node); + Result:=GetNode(Node,NextName,NextValue); +end; + +function TStringToStringTree.GetPrev(const Name: string; out PrevName, + PrevValue: string): Boolean; +var + Node: TAvgLvlTreeNode; +begin + Node:=FindNode(Name); + if Node<>nil then + Node:=Tree.FindPrecessor(Node); + Result:=GetNode(Node,PrevName,PrevValue); +end; + + +{ TPointerToPointerTree } + +function TPointerToPointerTree.GetCount: Integer; +begin + Result:=FItems.Count; +end; + +function TPointerToPointerTree.GetValues(const Key: Pointer): Pointer; +var + Node: TAvgLvlTreeNode; +begin + Node:=FindNode(Key); + if Node<>nil then + Result:=PPointerToPointerItem(Node.Data)^.Value + else + Result:=nil; +end; + +procedure TPointerToPointerTree.SetValues(const Key: Pointer; + const AValue: Pointer); +var + NewItem: PPointerToPointerItem; + Node: TAvgLvlTreeNode; +begin + Node:=FindNode(Key); + if (Node<>nil) then + PPointerToPointerItem(Node.Data)^.Value:=AValue + else begin + New(NewItem); + NewItem^.Key:=Key; + NewItem^.Value:=AValue; + FItems.Add(NewItem); + end; +end; + +function TPointerToPointerTree.FindNode(const Key: Pointer): TAvgLvlTreeNode; +begin + Result:=FItems.FindKey(@Key,@ComparePointerWithPtrToPtrItem) +end; + +function TPointerToPointerTree.GetNode(Node: TAvgLvlTreeNode; out Key, + Value: Pointer): Boolean; +var + Item: PPointerToPointerItem; +begin + if Node<>nil then begin + Item:=PPointerToPointerItem(Node.Data); + Key:=Item^.Key; + Value:=Item^.Value; + Result:=true; + end else begin + Key:=nil; + Value:=nil; + Result:=false; + end; +end; + +constructor TPointerToPointerTree.Create; +begin + FItems:=TAvgLvlTree.Create(@ComparePointerToPointerItems); +end; + +destructor TPointerToPointerTree.Destroy; +begin + Clear; + FItems.Free; + inherited Destroy; +end; + +procedure TPointerToPointerTree.Clear; +var + Node: TAvgLvlTreeNode; + Item: PPointerToPointerItem; +begin + Node:=FItems.FindLowest; + while Node<>nil do begin + Item:=PPointerToPointerItem(Node.Data); + Dispose(Item); + Node:=FItems.FindSuccessor(Node); + end; + FItems.Clear; +end; + +function TPointerToPointerTree.Contains(const Key: Pointer): Boolean; +begin + Result:=FindNode(Key)<>nil; +end; + +function TPointerToPointerTree.GetFirst(out Key, Value: Pointer): Boolean; +begin + Result:=GetNode(Tree.FindLowest,Key,Value); +end; + +function TPointerToPointerTree.GetLast(out Key, Value: Pointer): Boolean; +begin + Result:=GetNode(Tree.FindHighest,Key,Value); +end; + +function TPointerToPointerTree.GetNext(const Key: Pointer; out NextKey, + NextValue: Pointer): Boolean; +var + Node: TAvgLvlTreeNode; +begin + Node:=FindNode(Key); + if Node<>nil then + Node:=Tree.FindSuccessor(Node); + Result:=GetNode(Node,NextKey,NextValue); +end; + +function TPointerToPointerTree.GetPrev(const Key: Pointer; out PrevKey, + PrevValue: Pointer): Boolean; +var + Node: TAvgLvlTreeNode; +begin + Node:=FindNode(Key); + if Node<>nil then + Node:=Tree.FindPrecessor(Node); + Result:=GetNode(Node,PrevKey,PrevValue); +end; initialization - -NodeMemManager:=TAvgLvlTreeNodeMemManager.Create; + NodeMemManager:=TAvgLvlTreeNodeMemManager.Create; finalization - -NodeMemManager.Free; -NodeMemManager:=nil; + NodeMemManager.Free; + NodeMemManager:=nil; end. diff --git a/lcl/ldockctrl.pas b/lcl/ldockctrl.pas index 62da212dd1..e71af00546 100644 --- a/lcl/ldockctrl.pas +++ b/lcl/ldockctrl.pas @@ -37,7 +37,7 @@ interface uses Classes, Math, SysUtils, TypInfo, LCLProc, Controls, Forms, Menus, - LCLStrConsts, DynHashArray, StringHashList, LazConfigStorage, LDockCtrlEdit, + LCLStrConsts, AvgLvlTree, StringHashList, LazConfigStorage, LDockCtrlEdit, LDockTree; type @@ -2081,31 +2081,46 @@ function TLazDockConfigNode.DebugLayoutAsString: string; type TArrayOfRect = array of TRect; TNodeInfo = record - MinSizeValid: boolean; MinSize: TPoint; + MinSizeValid, MinSizeCalculating: boolean; + MinLeft: integer; + MinLeftValid, MinLeftCalculating: boolean; + MinTop: Integer; + MinTopValid, MinTopCalculating: boolean; end; PNodeInfo = ^TNodeInfo; var Cols: LongInt; Rows: LongInt; LogCols: Integer; - NodeInfos: TDynHashArray;// TLazDockConfigNode to PNodeInfo + NodeInfos: TPointerToPointerTree;// TLazDockConfigNode to PNodeInfo procedure InitNodeInfos; begin - NodeInfos:=TDynHashArray.Create; + NodeInfos:=TPointerToPointerTree.Create; end; - + procedure FreeNodeInfos; var Item: PNodeInfo; + NodePtr, InfoPtr: Pointer; begin + NodeInfos.GetFirst(NodePtr,InfoPtr); repeat - Item:=PNodeInfo(NodeInfos.First); + Item:=PNodeInfo(InfoPtr); if Item=nil then break; - NodeInfos.Remove(Item); Dispose(Item); - until false; + until not NodeInfos.GetNext(NodePtr,NodePtr,InfoPtr); + end; + + function GetNodeInfo(Node: TLazDockConfigNode): PNodeInfo; + begin + Result:=PNodeInfo(NodeInfos[Node]); + if Result=nil then begin + New(Result); + FillChar(Result^,SizeOf(Result),0); + NodeInfos[Node]:=Result; + end; end; procedure w(x,y: Integer; const s: string; MaxY: Integer = 0); @@ -2171,43 +2186,73 @@ var Result.Bottom:=MapY(OriginalRect.Left); end; - procedure UnIntersect(Rects: TArrayOfRect); - var - i: Integer; - j: Integer; - begin - for i:=1 to length(Rects)-1 do begin - for j:=0 to i-1 do begin - - end; - end; - end; - - procedure DrawNode(Node: TLazDockConfigNode; ARect: TRect); - var - i: Integer; - ChildRects: TArrayOfRect; - begin - wrectangle(ARect); - w(ARect.Left+1,ARect.Top,Node.Name,ARect.right); - - SetLength(ChildRects,Node.ChildCount); - for i:=0 to Node.ChildCount-1 do - ChildRects[i]:=MapRect(Node.Bounds,Node.ClientBounds,ARect); - UnIntersect(ChildRects); - for i:=0 to Node.ChildCount-1 do - DrawNode(Node.Childs[i],ChildRects[i]); - SetLength(ChildRects,0); - end; - function GetMinSize(Node: TLazDockConfigNode): TPoint; forward; + + function GetMinPos(Node: TLazDockConfigNode; Side: TAnchorKind): Integer; + // calculates left or top position of Node + + function Compute(var MinPosValid, MinPosCalculating: boolean; var MinPos: Integer): Integer; + + procedure Improve(Neighbour: TLazDockConfigNode); + var + NeighbourPos: LongInt; + NeighbourSize: TPoint; + NeighbourLength: LongInt; + begin + if Neighbour=nil then exit; + NeighbourPos:=GetMinPos(Neighbour,Side); + NeighbourSize:=GetMinSize(Neighbour); + if Side=akLeft then + NeighbourLength:=NeighbourSize.X + else + NeighbourLength:=NeighbourSize.Y; + MinPos:=Max(MinPos,NeighbourPos+NeighbourLength); + end; + + var + Sibling: TLazDockConfigNode; + i: Integer; + begin + if MinPosCalculating then begin + DebugLn(['DebugLayoutAsString.GetMinPos.Compute WARNING: anchor circle detected']); + exit(1); + end; + if (not MinPosValid) then begin + MinPosValid:=true; + MinPosCalculating:=true; + if Node.Sides[Side]<>'' then begin + Sibling:=FindByName(Node.Sides[Side],true,true); + Improve(Sibling); + end; + if Node.Parent<>nil then begin + for i:=0 to Node.Parent.ChildCount-1 do begin + Sibling:=Node.Parent.Childs[i]; + if CompareText(Sibling.Sides[OppositeAnchor[Side]],Node.Name)=0 then + Improve(Sibling); + end; + end; + MinPosCalculating:=false; + end; + Result:=MinPos; + end; + + var + Info: PNodeInfo; + begin + Info:=GetNodeInfo(Node); + if Side=akLeft then + Result:=Compute(Info^.MinLeftValid,Info^.MinLeftCalculating,Info^.MinLeft) + else + Result:=Compute(Info^.MinTopValid,Info^.MinTopCalculating,Info^.MinTop); + end; function GetChildsMinSize(Node: TLazDockConfigNode): TPoint; + // calculate the minimum size needed to draw the content of the node var i: Integer; ChildMinSize: TPoint; - NodesVerticallyComplete: TFPList; - NodesHorizontallyComplete: TFPList; + Child: TLazDockConfigNode; + ChildSize: TPoint; begin Result:=Point(0,0); if Node.TheType=ldcntPages then begin @@ -2218,30 +2263,74 @@ var Result.Y:=Max(Result.Y,ChildMinSize.Y); end; end else begin - NodesVerticallyComplete:=TFPList.Create; - NodesHorizontallyComplete:=TFPList.Create; - // TODO - NodesVerticallyComplete.Free; - NodesHorizontallyComplete.Free; + for i:=0 to Node.ChildCount-1 do begin + Child:=Node.Childs[i]; + ChildSize:=GetMinSize(Child); + Result.X:=Max(Result.X,GetMinPos(Child,akLeft)+ChildSize.X); + Result.Y:=Max(Result.Y,GetMinPos(Child,akTop)+ChildSize.Y); + end; end; end; function GetMinSize(Node: TLazDockConfigNode): TPoint; + // calculate the minimum size needed to draw the node var ChildMinSize: TPoint; + Info: PNodeInfo; begin - Result.X:=2+length(Node.Name); - Result.Y:=2; + Info:=GetNodeInfo(Node); + if Info^.MinSizeValid then begin + Result:=Info^.MinSize; + exit; + end; + if Info^.MinSizeCalculating then begin + DebugLn(['DebugLayoutAsString.GetMinSize WARNING: anchor circle detected']); + Result:=Point(1,1); + exit; + end; + Info^.MinSizeCalculating:=true; + Result.X:=2+length(Node.Name);// border plus caption + Result.Y:=2; // border if (Node.ChildCount=0) then begin case Node.TheType of ldcntSplitterLeftRight,ldcntSplitterUpDown: - Result:=Point(1,1); + Result:=Point(1,1); // splitters don't need captions end; end else begin ChildMinSize:=GetChildsMinSize(Node); Result.X:=Max(Result.X,ChildMinSize.X+2); Result.Y:=Max(Result.Y,ChildMinSize.Y+2); end; + Info^.MinSizeCalculating:=false; + Info^.MinSize:=Result; + Info^.MinSizeValid:=true; + end; + + procedure DrawNode(Node: TLazDockConfigNode; ARect: TRect); + var + i: Integer; + Child: TLazDockConfigNode; + ChildSize: TPoint; + ChildPos: TPoint; + ChildRect: TRect; + begin + wrectangle(ARect); + w(ARect.Left+1,ARect.Top,Node.Name,ARect.Right); + + for i := 0 to Node.ChildCount-1 do begin + Child:=Node.Childs[i]; + ChildSize:=GetMinSize(Child); + ChildPos:=Point(GetMinPos(Child,akLeft),GetMinPos(Child,akTop)); + ChildRect.Left:=ARect.Left+1+ChildPos.X; + ChildRect.Top:=ARect.Top+1+ChildPos.Y; + ChildRect.Right:=ChildRect.Left+ChildSize.X-1; + ChildRect.Bottom:=ChildRect.Top+ChildSize.Y-1; + DrawNode(Child,ChildRect); + if Node.TheType=ldcntPages then begin + // paint only one page + break; + end; + end; end; var @@ -2252,15 +2341,20 @@ begin Rows:=StrToIntDef(Application.GetOptionValue('ldcn-rows'),20); InitNodeInfos; - e:=LineEnding; - LogCols:=Cols+length(e); - SetLength(Result,LogCols*Rows); - // fill space - FillChar(Result[1],length(Result),' '); - // add line endings - for y:=1 to Rows do - w(Cols+1,y,e); - DrawNode(Self,Rect(1,1,Cols,Rows)); + try + e:=LineEnding; + LogCols:=Cols+length(e); + SetLength(Result,LogCols*Rows); + // fill space + FillChar(Result[1],length(Result),' '); + // add line endings + for y:=1 to Rows do + w(Cols+1,y,e); + // draw node + DrawNode(Self,Rect(1,1,Cols,Rows)); + finally + FreeNodeInfos; + end; end; function TLazDockConfigNode.GetPath: string;