paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-11 16:56:01 +02:00
Code Issues Packages Projects Releases Wiki Activity

freeing text converters

Browse Source 
git-svn-id: trunk@9691 -
This commit is contained in:
mattias 2006-07-29 08:52:16 +00:00
parent a91ea4d78a
commit 2a2d6b1152
8 changed files with 580 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/h2pas/h2pasdlg.pas
View File

@ -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;

4
components/h2pas/idetextconvlistedit.lfm
View File

@ -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

88
components/h2pas/idetextconvlistedit.lrs
View File

@ -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
]);

10
components/h2pas/idetextconvlistedit.pas
View File

@ -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:';

1
ide/main.pp
View File

@ -1185,6 +1185,7 @@ begin
FreeThenNil(Project1);
// free IDE parts
FreeTextConverters;
FreeStandardIDEQuickFixItems;
FreeFormEditor;
FreeAndNil(LazFindReplaceDialog);

6
ide/sourceeditprocs.pas
View File

@ -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;

375
lcl/avglvltree.pas
View File

@ -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.

206
lcl/ldockctrl.pas
View File

@ -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;