1 {
2 *****************************************************************************
3 This file is part of LazUtils.
4
5 See the file COPYING.modifiedLGPL.txt, included in this distribution,
6 for details about the license.
7 *****************************************************************************
8
9 Author: Mattias Gaertner
10
11 Abstract:
12 Defines classes that use TAvlTree for data storage, and enumerators for them.
13 TAvlTree is an Average Level binary Tree,
14 located in unit AVL_Tree in FPC packages.
15 }
16 unit AvgLvlTree;
17
18 {$mode objfpc}{$H+}
19
20 interface
21
22 uses
23 Classes, SysUtils, Laz_AVL_Tree,
24 LazFileUtils, LazDbgLog;
25
26 type
27
28 TAvgLvlTree = class;
29
reenull30 TAvgLvlObjectSortCompare = function(Tree: TAvgLvlTree; Data1, Data2: Pointer): integer of object;
31
32 { TAvgLvlTree and TAvgLvlTreeNode for backwards compatibility.
33 They used to be fully implemented here but now inherit from TAVLTreeNode and TAvlTree.
34 }
35 TAvgLvlTreeNode = TAVLTreeNode;
36 TAvgLvlTreeNodeEnumerator = TAVLTreeNodeEnumerator;
37
38 TAvgLvlTree = class(TAvlTree)
39 private
40 FOwnsObjects: boolean;
GetObjectComparenull41 function GetObjectCompare: TAvgLvlObjectSortCompare;
42 procedure SetObjectCompare(AValue: TAvgLvlObjectSortCompare);
43 public
44 constructor CreateObjectCompare(const OnCompareMethod: TAvgLvlObjectSortCompare);
45 procedure DisposeNode(aNode: TAVLTreeNode); override;
46 procedure FreeAndDelete(ANode: TAVLTreeNode); override;
47 property OwnsObjects: boolean read FOwnsObjects write FOwnsObjects;
48 property OnObjectCompare: TAvgLvlObjectSortCompare read GetObjectCompare write SetObjectCompare;
49 end;
50 TAvgLvlTreeClass = class of TAvgLvlTree;
51
52 { TIndexedAVLTreeNode }
53
54 TIndexedAVLTreeNode = class(TAvlTreeNode)
55 public
56 LeftCount: SizeInt; // number of nodes in the Left side
57 end;
58
59 { TIndexedAVLTree }
60
61 TIndexedAVLTree = class(TAvgLvlTree)
62 private
GetItemsnull63 function GetItems(Index: SizeInt): Pointer; inline;
64 protected
65 fLastIndex: SizeInt;
66 fLastNode: TIndexedAVLTreeNode;
67 procedure DeletingNode(aNode: TAvlTreeNode); override;
68 procedure Init; override;
69 procedure NodeAdded(aNode: TAvlTreeNode); override;
70 procedure RotateLeft(aNode: TAvlTreeNode); override;
71 procedure RotateRight(aNode: TAvlTreeNode); override;
72 procedure SwitchPositionWithSuccessor(aNode, aSuccessor: TAvlTreeNode); override;
73 public
GetNodeAtIndexnull74 function GetNodeAtIndex(Index: integer): TIndexedAVLTreeNode;
NodeToIndexnull75 function NodeToIndex(Node: TAvlTreeNode): SizeInt;
IndexOfnull76 function IndexOf(Data: Pointer): SizeInt;
77 property Items[Index: SizeInt]: Pointer read GetItems; default;
78 procedure ConsistencyCheck; override;
NodeToReportStrnull79 function NodeToReportStr(aNode: TAvlTreeNode): string; override;
80 end;
81
82 { TPointerToPointerTree - Associative array }
83
84 TPointerToPointerItem = record
85 Key: Pointer;
86 Value: Pointer;
87 end;
88 PPointerToPointerItem = ^TPointerToPointerItem;
89
90 { TPointerToPointerEnumerator }
91
92 TPointerToPointerEnumerator = class
93 protected
94 FHighToLow: boolean;
95 FTree: TAvlTree;
96 FCurrent: TAvlTreeNode;
GetCurrentnull97 function GetCurrent: PPointerToPointerItem; inline;
98 public
99 constructor Create(Tree: TAvlTree);
GetEnumeratornull100 function GetEnumerator: TPointerToPointerEnumerator; inline;
MoveNextnull101 function MoveNext: Boolean;
102 property Current: PPointerToPointerItem read GetCurrent;
103 property HighToLow: boolean read FHighToLow;
104 end;
105
106 TPointerToPointerTree = class
107 private
108 FItems: TAvlTree;
GetCountnull109 function GetCount: SizeInt; inline;
GetValuesnull110 function GetValues(const Key: Pointer): Pointer;
111 procedure SetValues(const Key: Pointer; const AValue: Pointer);
FindNodenull112 function FindNode(const Key: Pointer): TAvlTreeNode;
GetNodenull113 function GetNode(Node: TAvlTreeNode; out Key, Value: Pointer): Boolean;
114 public
115 constructor Create;
116 destructor Destroy; override;
117 procedure Clear;
118 procedure ClearWithFree; // free Values with TObject(Value).Free
Equalsnull119 function Equals(Obj: TObject): boolean; override;
IsEqualnull120 function IsEqual(aTree: TPointerToPointerTree): boolean;
121 procedure Assign(aTree: TPointerToPointerTree);
122 procedure Remove(Key: Pointer);
Containsnull123 function Contains(const Key: Pointer): Boolean; inline;
GetFirstnull124 function GetFirst(out Key, Value: Pointer): Boolean;
GetLastnull125 function GetLast(out Key, Value: Pointer): Boolean;
GetNextnull126 function GetNext(const Key: Pointer; out NextKey, NextValue: Pointer): Boolean;
GetPrevnull127 function GetPrev(const Key: Pointer; out PrevKey, PrevValue: Pointer): Boolean;
FindByValuenull128 function FindByValue(Value: Pointer): Pointer; // Returns the Key or Nil.
129 property Count: SizeInt read GetCount;
130 property Values[const Key: Pointer]: Pointer read GetValues write SetValues; default;
131 property Tree: TAvlTree read FItems; // tree of PPointerToPointerItem
132
133 // enumerators
GetEnumeratornull134 function GetEnumerator: TPointerToPointerEnumerator;
GetEnumeratorHighToLownull135 function GetEnumeratorHighToLow: TPointerToPointerEnumerator;
136 end;
137
138 TStringMapItem = record
139 Name: string;
140 end;
141 PStringMapItem = ^TStringMapItem;
142
143 { TCustomStringMapEnumerator }
144
145 TCustomStringMapEnumerator = class
146 protected
147 FTree: TAvlTree;
148 FCurrent: TAvlTreeNode;
149 public
150 constructor Create(Tree: TAvlTree);
MoveNextnull151 function MoveNext: boolean;
152 // "Current" is implemented by the descendant classes
153 end;
154
155 { TCustomStringMap }
156
157 TCustomStringMap = class
158 private
159 FCompareKeyItemFunc: TListSortCompare;
160 FTree: TAvlTree;// tree of PStringMapItem
161 FCaseSensitive: boolean;
GetCompareItemsFuncnull162 function GetCompareItemsFunc: TListSortCompare;
163 protected
164 procedure DisposeItem(p: PStringMapItem); virtual;
ItemsAreEqualnull165 function ItemsAreEqual(p1, p2: PStringMapItem): boolean; virtual;
CreateCopynull166 function CreateCopy(Src: PStringMapItem): PStringMapItem; virtual;
167 public
168 constructor Create(TheCaseSensitive: boolean);
169 constructor Create(const ACompareItems, ACompareNameWithItem: TListSortCompare;
170 TheCaseSensitive: boolean = false);
171 destructor Destroy; override;
172 procedure Clear; virtual;
Containsnull173 function Contains(const s: string): boolean; inline;
174 procedure GetNames(List: TStrings);
175 procedure Remove(const Name: string); virtual;
176 property CaseSensitive: boolean read FCaseSensitive;
177 property Tree: TAvlTree read FTree; // tree of PStringMapItem
FindNodenull178 function FindNode(const s: string): TAvlTreeNode;
Countnull179 function Count: SizeInt; inline;
Equalsnull180 function Equals(OtherTree: TCustomStringMap): boolean; reintroduce;
181 procedure Assign(Source: TCustomStringMap); virtual;
CalcMemSizenull182 function CalcMemSize: PtrUint; virtual;
183 property CompareItemsFunc: TListSortCompare read GetCompareItemsFunc;
184 property CompareKeyItemFunc: TListSortCompare read FCompareKeyItemFunc;
185 procedure SetCompareFuncs(const NewCompareItemsFunc,
186 NewCompareKeyItemFunc: TListSortCompare
187 {; NewCaseSensitive: boolean});
188 end;
189
190 { TStringMapEnumerator }
191
192 TStringMapEnumerator = class(TCustomStringMapEnumerator)
193 private
GetCurrentnull194 function GetCurrent: string; inline;
195 public
196 property Current: string read GetCurrent;
197 end;
198
199 { TStringMap - associative array string to boolean }
200
201 TStringMap = class(TCustomStringMap)
202 private
GetValuesnull203 function GetValues(const s: string): boolean;
204 procedure SetValues(const s: string; AValue: boolean);
205 public
206 procedure Add(const Name: string);
GetEnumeratornull207 function GetEnumerator: TStringMapEnumerator;
208 property Values[const s: string]: boolean read GetValues write SetValues; default;
209 end;
210
211 { TStringToStringTree - Associative array string to string }
212
213 TStringToStringItem = record
214 Name: string;
215 Value: string;
216 end;
217 PStringToStringItem = ^TStringToStringItem;
218
219 { TStringToStringTreeEnumerator }
220
221 TStringToStringTreeEnumerator = class(TCustomStringMapEnumerator)
222 private
GetCurrentnull223 function GetCurrent: PStringToStringItem; inline;
224 public
225 property Current: PStringToStringItem read GetCurrent;
226 end;
227
228 TStringToStringTree = class(TCustomStringMap)
229 private
GetValuesnull230 function GetValues(const s: string): string;
231 procedure SetValues(const s: string; const AValue: string);
232 protected
233 procedure DisposeItem(p: PStringMapItem); override;
ItemsAreEqualnull234 function ItemsAreEqual(p1, p2: PStringMapItem): boolean; override;
CreateCopynull235 function CreateCopy(Src: PStringMapItem): PStringMapItem; override;
GetNodenull236 function GetNode(Node: TAvlTreeNode; out Name, Value: string): Boolean;
237 public
GetStringnull238 function GetString(const Name: string; out Value: string): boolean;
239 procedure Add(const Name, Value: string); inline;
240 procedure Add(const Name, Value, Delimiter: string);
241 procedure AddNameValues(List: TStrings);
242 procedure AddNames(List: TStrings);
243 property Values[const s: string]: string read GetValues write SetValues; default;
GetNodeDatanull244 function GetNodeData(Node: TAVLTreeNode): PStringToStringItem; inline;
AsTextnull245 function AsText: string;
246 procedure Assign(Source: TCustomStringMap); override;
CalcMemSizenull247 function CalcMemSize: PtrUint; override;
GetEnumeratornull248 function GetEnumerator: TStringToStringTreeEnumerator;
GetFirstnull249 function GetFirst(out Name, Value: string): Boolean;
GetLastnull250 function GetLast(out Name, Value: string): Boolean;
GetNextnull251 function GetNext(const Name: string; out NextName, NextValue: string): Boolean;
GetPrevnull252 function GetPrev(const Name: string; out PrevName, PrevValue: string): Boolean;
253 end;
254
255 { TStringToPointerTree }
256
257 TStringToPointerTreeItem = record
258 Name: string;
259 Value: Pointer;
260 end;
261 PStringToPointerTreeItem = ^TStringToPointerTreeItem;
262
263 { TStringToPointerTreeEnumerator }
264
265 TStringToPointerTreeEnumerator = class(TStringMapEnumerator)
266 private
GetCurrentnull267 function GetCurrent: PStringToPointerTreeItem;
268 public
269 property Current: PStringToPointerTreeItem read GetCurrent;
270 end;
271
272 TStringToPointerTree = class(TCustomStringMap)
273 private
274 FFreeValues: boolean;
GetValuesnull275 function GetValues(const s: string): Pointer;
276 procedure SetValues(const s: string; const AValue: Pointer);
277 protected
278 procedure DisposeItem(p: PStringMapItem); override;
ItemsAreEqualnull279 function ItemsAreEqual(p1, p2: PStringMapItem): boolean; override;
CreateCopynull280 function CreateCopy(Src: PStringMapItem): PStringMapItem; override;
281 public
GetDatanull282 function GetData(const Name: string; out Value: Pointer): boolean;
GetNodeDatanull283 function GetNodeData(Node: TAVLTreeNode): PStringToPointerTreeItem; inline;
GetEnumeratornull284 function GetEnumerator: TStringToPointerTreeEnumerator;
285 property FreeValues: boolean read FFreeValues write FFreeValues;
286 property Values[const s: string]: Pointer read GetValues write SetValues; default;
287 end;
288
289 { TFilenameToStringTree }
290
291 TFilenameToStringTree = class(TStringToStringTree)
292 public
293 constructor Create(CaseInsensitive: boolean); // false = system default
294 end;
295
296 { TFilenameToPointerTree }
297
298 TFilenameToPointerTree = class(TStringToPointerTree)
299 public
300 constructor Create(CaseInsensitive: boolean); // false = system default
301 end;
302
303
ComparePointernull304 function ComparePointer(Data1, Data2: Pointer): integer;
ComparePointerToPointerItemsnull305 function ComparePointerToPointerItems(Data1, Data2: Pointer): integer;
ComparePointerWithPtrToPtrItemnull306 function ComparePointerWithPtrToPtrItem(Key, Data: Pointer): Integer;
307
CompareStringToStringItemsnull308 function CompareStringToStringItems(Data1, Data2: Pointer): integer;
CompareAnsiStringWithStrToStrItemnull309 function CompareAnsiStringWithStrToStrItem(Key, Data: Pointer): Integer;
CompareStringToStringItemsInull310 function CompareStringToStringItemsI(Data1, Data2: Pointer): integer;
CompareAnsiStringWithStrToStrItemInull311 function CompareAnsiStringWithStrToStrItemI(Key, Data: Pointer): Integer;
312
CompareFilenameToStringItemsnull313 function CompareFilenameToStringItems(Data1, Data2: Pointer): integer;
CompareFilenameAndFilenameToStringTreeItemnull314 function CompareFilenameAndFilenameToStringTreeItem(Key, Data: Pointer): integer;
CompareFilenameToStringItemsInull315 function CompareFilenameToStringItemsI(Data1, Data2: Pointer): integer;
CompareFilenameAndFilenameToStringTreeItemInull316 function CompareFilenameAndFilenameToStringTreeItemI(Key, Data: Pointer): integer;
317
318
319 implementation
320
ComparePointernull321 function ComparePointer(Data1, Data2: Pointer): integer;
322 begin
323 if Data1>Data2 then Result:=-1
324 else if Data1<Data2 then Result:=1
325 else Result:=0;
326 end;
327
ComparePointerToPointerItemsnull328 function ComparePointerToPointerItems(Data1, Data2: Pointer): integer;
329 begin
330 Result:=ComparePointer(PPointerToPointerItem(Data1)^.Key,
331 PPointerToPointerItem(Data2)^.Key);
332 end;
333
ComparePointerWithPtrToPtrItemnull334 function ComparePointerWithPtrToPtrItem(Key, Data: Pointer): Integer;
335 begin
336 Result:=ComparePointer(Key,PPointerToPointerItem(Data)^.Key);
337 end;
338
CompareStringToStringItemsnull339 function CompareStringToStringItems(Data1, Data2: Pointer): integer;
340 begin
341 Result:=CompareStr(PStringMapItem(Data1)^.Name,
342 PStringMapItem(Data2)^.Name);
343 end;
344
CompareStringToStringItemsInull345 function CompareStringToStringItemsI(Data1, Data2: Pointer): integer;
346 begin
347 Result:=CompareText(PStringMapItem(Data1)^.Name,
348 PStringMapItem(Data2)^.Name);
349 end;
350
CompareAnsiStringWithStrToStrItemnull351 function CompareAnsiStringWithStrToStrItem(Key, Data: Pointer): Integer;
352 begin
353 Result:=CompareStr(AnsiString(Key),PStringMapItem(Data)^.Name);
354 end;
355
CompareAnsiStringWithStrToStrItemInull356 function CompareAnsiStringWithStrToStrItemI(Key, Data: Pointer): Integer;
357 begin
358 Result:=CompareText(AnsiString(Key),PStringMapItem(Data)^.Name);
359 end;
360
CompareFilenameToStringItemsnull361 function CompareFilenameToStringItems(Data1, Data2: Pointer): integer;
362 begin
363 Result:=CompareFilenames(PStringToStringItem(Data1)^.Name,
364 PStringToStringItem(Data2)^.Name);
365 end;
366
CompareFilenameAndFilenameToStringTreeItemnull367 function CompareFilenameAndFilenameToStringTreeItem(Key, Data: Pointer): integer;
368 begin
369 Result:=CompareFilenames(String(Key),PStringToStringItem(Data)^.Name);
370 end;
371
CompareFilenameToStringItemsInull372 function CompareFilenameToStringItemsI(Data1, Data2: Pointer): integer;
373 begin
374 Result:=CompareFilenamesIgnoreCase(PStringToStringItem(Data1)^.Name,
375 PStringToStringItem(Data2)^.Name);
376 end;
377
CompareFilenameAndFilenameToStringTreeItemInull378 function CompareFilenameAndFilenameToStringTreeItemI(Key, Data: Pointer): integer;
379 begin
380 Result:=CompareFilenamesIgnoreCase(String(Key),
381 PStringToStringItem(Data)^.Name);
382 end;
383
384 { TAvgLvlTree }
385
386 constructor TAvgLvlTree.CreateObjectCompare(const OnCompareMethod: TAvgLvlObjectSortCompare);
387 begin
388 inherited CreateObjectCompare(TObjectSortCompare(OnCompareMethod));
389 end;
390
391 procedure TAvgLvlTree.SetObjectCompare(AValue: TAvgLvlObjectSortCompare);
392 begin
393 inherited SetOnObjectCompare(TObjectSortCompare(AValue));
394 end;
395
GetObjectComparenull396 function TAvgLvlTree.GetObjectCompare: TAvgLvlObjectSortCompare;
397 begin
398 Result := TAvgLvlObjectSortCompare(FOnObjectCompare);
399 end;
400
401 procedure TAvgLvlTree.DisposeNode(aNode: TAVLTreeNode);
402 begin
403 if FOwnsObjects and Assigned(aNode) then
404 begin
405 TObject(aNode.Data).Free;
406 aNode.Data := nil;
407 end;
408 inherited DisposeNode(aNode);
409 end;
410
411 procedure TAvgLvlTree.FreeAndDelete(ANode: TAVLTreeNode);
412 begin
413 if FOwnsObjects then
414 Delete(ANode)
415 else
416 inherited FreeAndDelete(aNode);
417 end;
418
419 { TPointerToPointerEnumerator }
420
GetCurrentnull421 function TPointerToPointerEnumerator.GetCurrent: PPointerToPointerItem;
422 begin
423 Result:=PPointerToPointerItem(FCurrent.Data);
424 end;
425
426 constructor TPointerToPointerEnumerator.Create(Tree: TAvlTree);
427 begin
428 FTree:=Tree;
429 end;
430
GetEnumeratornull431 function TPointerToPointerEnumerator.GetEnumerator: TPointerToPointerEnumerator;
432 begin
433 Result:=Self;
434 end;
435
MoveNextnull436 function TPointerToPointerEnumerator.MoveNext: Boolean;
437 begin
438 if FHighToLow then begin
439 if FCurrent<>nil then
440 FCurrent:=FCurrent.Precessor
441 else
442 FCurrent:=FTree.FindHighest;
443 end else begin
444 if FCurrent<>nil then
445 FCurrent:=FCurrent.Successor
446 else
447 FCurrent:=FTree.FindLowest;
448 end;
449 Result:=FCurrent<>nil;
450 end;
451
452 { TStringToPointerTree }
453
GetValuesnull454 function TStringToPointerTree.GetValues(const s: string): Pointer;
455 var
456 Node: TAvlTreeNode;
457 begin
458 Node:=FindNode(s);
459 if Node<>nil then
460 Result:=PStringToPointerTreeItem(Node.Data)^.Value
461 else
462 Result:=nil
463 end;
464
465 procedure TStringToPointerTree.SetValues(const s: string; const AValue: Pointer);
466 var
467 Node: TAvlTreeNode;
468 Item: PStringToPointerTreeItem;
469 begin
470 Node:=FindNode(s);
471 if Node<>nil then begin
472 Item:=PStringToPointerTreeItem(Node.Data);
473 if Item^.Value=AValue then exit;
474 if FreeValues then
475 TObject(Item^.Value).Free;
476 Item^.Value:=AValue;
477 end else begin
478 New(Item);
479 Item^.Name:=s;
480 Item^.Value:=AValue;
481 FTree.Add(Item);
482 end;
483 end;
484
485 procedure TStringToPointerTree.DisposeItem(p: PStringMapItem);
486 var
487 Item: PStringToPointerTreeItem absolute p;
488 begin
489 if FreeValues then
490 TObject(Item^.Value).Free;
491 Dispose(Item);
492 end;
493
ItemsAreEqualnull494 function TStringToPointerTree.ItemsAreEqual(p1, p2: PStringMapItem): boolean;
495 var
496 Item1: PStringToPointerTreeItem absolute p1;
497 Item2: PStringToPointerTreeItem absolute p2;
498 begin
499 Result:=(Item1^.Name=Item2^.Name)
500 and (Item1^.Value=Item2^.Value);
501 end;
502
CreateCopynull503 function TStringToPointerTree.CreateCopy(Src: PStringMapItem): PStringMapItem;
504 var
505 SrcItem: PStringToPointerTreeItem absolute Src;
506 NewItem: PStringToPointerTreeItem;
507 begin
508 New(NewItem);
509 NewItem^.Name:=SrcItem^.Name;
510 NewItem^.Value:=SrcItem^.Value;
511 Result:=PStringMapItem(NewItem);
512 end;
513
TStringToPointerTree.GetDatanull514 function TStringToPointerTree.GetData(const Name: string; out Value: Pointer): boolean;
515 var
516 Node: TAvlTreeNode;
517 begin
518 Node:=FindNode(Name);
519 if Node<>nil then begin
520 Value:=PStringToPointerTreeItem(Node.Data)^.Value;
521 Result:=true;
522 end else begin
523 Result:=false;
524 end;
525 end;
526
TStringToPointerTree.GetNodeDatanull527 function TStringToPointerTree.GetNodeData(Node: TAVLTreeNode): PStringToPointerTreeItem;
528 begin
529 Result:=PStringToPointerTreeItem(Node.Data);
530 end;
531
GetEnumeratornull532 function TStringToPointerTree.GetEnumerator: TStringToPointerTreeEnumerator;
533 begin
534 Result:=TStringToPointerTreeEnumerator.Create(FTree);
535 end;
536
537 { TFilenameToStringTree }
538
539 constructor TFilenameToStringTree.Create(CaseInsensitive: boolean);
540 begin
541 inherited Create(true);
542 if CaseInsensitive then
543 SetCompareFuncs(@CompareFilenameToStringItemsI,
544 @CompareFilenameAndFilenameToStringTreeItemI)
545 else
546 SetCompareFuncs(@CompareFilenameToStringItems,
547 @CompareFilenameAndFilenameToStringTreeItem);
548 end;
549
550 { TFilenameToPointerTree }
551
552 constructor TFilenameToPointerTree.Create(CaseInsensitive: boolean);
553 begin
554 inherited Create(true);
555 if CaseInsensitive then
556 SetCompareFuncs(@CompareFilenameToStringItemsI,
557 @CompareFilenameAndFilenameToStringTreeItemI)
558 else
559 SetCompareFuncs(@CompareFilenameToStringItems,
560 @CompareFilenameAndFilenameToStringTreeItem);
561 end;
562
563 { TStringToStringTree }
564
GetValuesnull565 function TStringToStringTree.GetValues(const s: string): string;
566 var
567 Node: TAvlTreeNode;
568 begin
569 Node:=FindNode(s);
570 if Node<>nil then
571 Result:=PStringToStringItem(Node.Data)^.Value
572 else
573 Result:=''
574 end;
575
576 procedure TStringToStringTree.SetValues(const s: string; const AValue: string);
577 var
578 Node: TAvlTreeNode;
579 Item: PStringToStringItem;
580 begin
581 Node:=FindNode(s);
582 if Node<>nil then begin
583 Item:=PStringToStringItem(Node.Data);
584 Item^.Name:=s; // update case
585 Item^.Value:=AValue;
586 end else begin
587 New(Item);
588 Item^.Name:=s;
589 Item^.Value:=AValue;
590 FTree.Add(Item);
591 end;
592 end;
593
594 procedure TStringToStringTree.DisposeItem(p: PStringMapItem);
595 var
596 Item: PStringToStringItem absolute p;
597 begin
598 Dispose(Item);
599 end;
600
ItemsAreEqualnull601 function TStringToStringTree.ItemsAreEqual(p1, p2: PStringMapItem): boolean;
602 var
603 Item1: PStringToStringItem absolute p1;
604 Item2: PStringToStringItem absolute p2;
605 begin
606 Result:=(Item1^.Name=Item2^.Name)
607 and (Item1^.Value=Item2^.Value);
608 end;
609
TStringToStringTree.CreateCopynull610 function TStringToStringTree.CreateCopy(Src: PStringMapItem): PStringMapItem;
611 var
612 SrcItem: PStringToStringItem absolute Src;
613 NewItem: PStringToStringItem;
614 begin
615 New(NewItem);
616 NewItem^.Name:=SrcItem^.Name;
617 NewItem^.Value:=SrcItem^.Value;
618 Result:=PStringMapItem(NewItem);
619 end;
620
GetNodenull621 function TStringToStringTree.GetNode(Node: TAvlTreeNode; out Name, Value: string
622 ): Boolean;
623 var
624 Item: PStringToStringItem;
625 begin
626 if Node<>nil then begin
627 Item:=PStringToStringItem(Node.Data);
628 Name:=Item^.Name;
629 Value:=Item^.Value;
630 Result:=true;
631 end else begin
632 Name:='';
633 Value:='';
634 Result:=false;
635 end;
636 end;
637
GetStringnull638 function TStringToStringTree.GetString(const Name: string; out Value: string): boolean;
639 var
640 Node: TAvlTreeNode;
641 begin
642 Node:=FindNode(Name);
643 if Node<>nil then begin
644 Value:=PStringToStringItem(Node.Data)^.Value;
645 Result:=true;
646 end else begin
647 Result:=false;
648 end;
649 end;
650
651 procedure TStringToStringTree.Add(const Name, Value: string);
652 begin
653 Values[Name]:=Value;
654 end;
655
656 procedure TStringToStringTree.Add(const Name, Value, Delimiter: string);
657 var
658 OldValue: string;
659 begin
660 OldValue:=Values[Name];
661 if OldValue<>'' then
662 OldValue:=OldValue+Delimiter;
663 OldValue:=OldValue+Value;
664 Values[Name]:=OldValue;
665 end;
666
667 procedure TStringToStringTree.AddNameValues(List: TStrings);
668 var
669 i: Integer;
670 begin
671 for i:=0 to List.Count-1 do
672 Values[List.Names[i]]:=List.ValueFromIndex[i];
673 end;
674
675 procedure TStringToStringTree.AddNames(List: TStrings);
676 var
677 i: Integer;
678 begin
679 for i:=0 to List.Count-1 do
680 Values[List[i]]:='';
681 end;
682
TStringToStringTree.GetNodeDatanull683 function TStringToStringTree.GetNodeData(Node: TAVLTreeNode): PStringToStringItem;
684 begin
685 Result:=PStringToStringItem(Node.Data);
686 end;
687
TStringToStringTree.GetFirstnull688 function TStringToStringTree.GetFirst(out Name, Value: string): Boolean;
689 begin
690 Result:=GetNode(Tree.FindLowest,Name,Value);
691 end;
692
TStringToStringTree.GetLastnull693 function TStringToStringTree.GetLast(out Name, Value: string): Boolean;
694 begin
695 Result:=GetNode(Tree.FindHighest,Name,Value);
696 end;
697
GetNextnull698 function TStringToStringTree.GetNext(const Name: string; out NextName,
699 NextValue: string): Boolean;
700 var
701 Node: TAvlTreeNode;
702 begin
703 Node:=FindNode(Name);
704 if Node<>nil then
705 Node:=Node.Successor;
706 Result:=GetNode(Node,NextName,NextValue);
707 end;
708
GetPrevnull709 function TStringToStringTree.GetPrev(const Name: string; out PrevName,
710 PrevValue: string): Boolean;
711 var
712 Node: TAvlTreeNode;
713 begin
714 Node:=FindNode(Name);
715 if Node<>nil then
716 Node:=Node.Precessor;
717 Result:=GetNode(Node,PrevName,PrevValue);
718 end;
719
AsTextnull720 function TStringToStringTree.AsText: string;
721 var
722 Node: TAvlTreeNode;
723 Item: PStringToStringItem;
724 begin
725 Result:='';
726 Node:=Tree.FindLowest;
727 while Node<>nil do begin
728 Item:=PStringToStringItem(Node.Data);
729 Result:=Result+Item^.Name+'='+Item^.Value+LineEnding;
730 Node:=Node.Successor;
731 end;
732 end;
733
734 procedure TStringToStringTree.Assign(Source: TCustomStringMap);
735 var
736 Node: TAvlTreeNode;
737 Item: PStringToStringItem;
738 begin
739 if (Source=nil) or (Source.ClassType<>ClassType) then
740 raise Exception.Create('invalid class');
741 Clear;
742 Node:=Source.Tree.FindLowest;
743 while Node<>nil do begin
744 Item:=PStringToStringItem(Node.Data);
745 Values[Item^.Name]:=Item^.Value;
746 Node:=Node.Successor;
747 end;
748 end;
749
TStringToStringTree.CalcMemSizenull750 function TStringToStringTree.CalcMemSize: PtrUint;
751 var
752 Node: TAvlTreeNode;
753 Item: PStringToStringItem;
754 begin
755 Result:=PtrUInt(InstanceSize)
756 +PtrUInt(FTree.InstanceSize)
757 +PtrUint(FTree.Count)*SizeOf(TAvlTreeNode);
758 Node:=FTree.FindLowest;
759 while Node<>nil do begin
760 Item:=PStringToStringItem(Node.Data);
761 inc(Result,MemSizeString(Item^.Name)
762 +MemSizeString(Item^.Value)
763 +SizeOf(TStringToStringItem));
764 Node:=FTree.FindSuccessor(Node);
765 end;
766 end;
767
TStringToStringTree.GetEnumeratornull768 function TStringToStringTree.GetEnumerator: TStringToStringTreeEnumerator;
769 begin
770 Result:=TStringToStringTreeEnumerator.Create(FTree);
771 end;
772
773 { TStringToPointerTreeEnumerator }
774
TStringToPointerTreeEnumerator.GetCurrentnull775 function TStringToPointerTreeEnumerator.GetCurrent: PStringToPointerTreeItem;
776 begin
777 Result:=PStringToPointerTreeItem(FCurrent.Data);
778 end;
779
780 { TStringMapEnumerator }
781
TStringMapEnumerator.GetCurrentnull782 function TStringMapEnumerator.GetCurrent: string;
783 begin
784 Result:=PStringMapItem(FCurrent.Data)^.Name;
785 end;
786
787 { TStringMap }
788
GetValuesnull789 function TStringMap.GetValues(const s: string): boolean;
790 begin
791 Result:=Contains(s);
792 end;
793
794 procedure TStringMap.SetValues(const s: string; AValue: boolean);
795 begin
796 if AValue then
797 Add(s)
798 else
799 Remove(s);
800 end;
801
802 procedure TStringMap.Add(const Name: string);
803 var
804 Node: TAvlTreeNode;
805 NewItem: PStringMapItem;
806 begin
807 Node:=FindNode(Name);
808 if Node<>nil then begin
809 exit;
810 end else begin
811 New(NewItem);
812 NewItem^.Name:=Name;
813 FTree.Add(NewItem);
814 end;
815 end;
816
GetEnumeratornull817 function TStringMap.GetEnumerator: TStringMapEnumerator;
818 begin
819 Result:=TStringMapEnumerator.Create(Tree);
820 end;
821
822 { TStringToStringTreeEnumerator }
823
GetCurrentnull824 function TStringToStringTreeEnumerator.GetCurrent: PStringToStringItem;
825 begin
826 Result:=PStringToStringItem(FCurrent.Data);
827 end;
828
829 { TIndexedAVLTree }
830
TIndexedAVLTree.GetItemsnull831 function TIndexedAVLTree.GetItems(Index: SizeInt): Pointer;
832 begin
833 Result:=GetNodeAtIndex(Index).Data;
834 end;
835
836 procedure TIndexedAVLTree.DeletingNode(aNode: TAvlTreeNode);
837 var
838 aParent: TAvlTreeNode;
839 begin
840 fLastNode:=nil;
841 repeat
842 aParent:=aNode.Parent;
843 if (aParent=nil) then exit;
844 if aParent.Left=aNode then
845 TIndexedAVLTreeNode(aParent).LeftCount-=1;
846 aNode:=aParent;
847 until false;
848 end;
849
850 procedure TIndexedAVLTree.Init;
851 begin
852 NodeClass:=TIndexedAVLTreeNode;
853 end;
854
855 procedure TIndexedAVLTree.NodeAdded(aNode: TAvlTreeNode);
856 var
857 aParent: TAvlTreeNode;
858 begin
859 fLastNode:=nil;
860 repeat
861 aParent:=aNode.Parent;
862 if (aParent=nil) then exit;
863 if aParent.Left=aNode then
864 TIndexedAVLTreeNode(aParent).LeftCount+=1;
865 aNode:=aParent;
866 until false;
867 end;
868
869 procedure TIndexedAVLTree.RotateLeft(aNode: TAvlTreeNode);
870 { Parent Parent
871 | |
872 CurNode => OldRight
873 / \ /
874 Left OldRight CurNode
875 / / \
876 OldRightLeft Left OldRightLeft }
877 var
878 CurNode: TIndexedAVLTreeNode absolute aNode;
879 OldRight: TIndexedAVLTreeNode;
880 begin
881 OldRight:=TIndexedAVLTreeNode(aNode.Right);
882 inherited RotateLeft(aNode);
883 OldRight.LeftCount += 1+CurNode.LeftCount;
884 end;
885
886 procedure TIndexedAVLTree.RotateRight(aNode: TAvlTreeNode);
887 { Parent Parent
888 | |
889 CurNode => OldLeft
890 / \ \
891 OldLeft Right CurNode
892 \ / \
893 OldLeftRight OldLeftRight Right }
894 var
895 CurNode: TIndexedAVLTreeNode absolute aNode;
896 OldLeft: TIndexedAVLTreeNode;
897 begin
898 OldLeft:=TIndexedAVLTreeNode(aNode.Left);
899 inherited RotateRight(aNode);
900 CurNode.LeftCount -= (1 + OldLeft.LeftCount);
901 end;
902
903 procedure TIndexedAVLTree.SwitchPositionWithSuccessor(aNode,
904 aSuccessor: TAvlTreeNode);
905 var
906 CurNode: TIndexedAVLTreeNode absolute aNode;
907 CurSucc: TIndexedAVLTreeNode absolute aSuccessor;
908 h: SizeInt;
909 begin
910 h:=CurNode.LeftCount;
911 CurNode.LeftCount:=CurSucc.LeftCount;
912 CurSucc.LeftCount:=h;
913 inherited SwitchPositionWithSuccessor(aNode, aSuccessor);
914 end;
915
TIndexedAVLTree.GetNodeAtIndexnull916 function TIndexedAVLTree.GetNodeAtIndex(Index: integer): TIndexedAVLTreeNode;
917
918 procedure RaiseOutOfBounds;
919 begin
920 raise Exception.Create('TIndexedAVLTree: Index '+IntToStr(Index)+' out of bounds 0..'+IntToStr(Count));
921 end;
922
923 begin
924 if (Index<0) or (Index>=Count) then
925 RaiseOutOfBounds;
926
927 if fLastNode<>nil then begin
928 if Index=fLastIndex then
929 exit(fLastNode)
930 else if Index=fLastIndex+1 then begin
931 fLastIndex:=Index;
932 fLastNode:=TIndexedAVLTreeNode(fLastNode.Successor);
933 exit(fLastNode);
934 end else if Index=fLastIndex-1 then begin
935 fLastIndex:=Index;
936 fLastNode:=TIndexedAVLTreeNode(fLastNode.Precessor);
937 exit(fLastNode);
938 end;
939 end;
940
941 fLastIndex:=Index;
942 Result:=TIndexedAVLTreeNode(Root);
943 repeat
944 if Result.LeftCount>Index then
945 Result:=TIndexedAVLTreeNode(Result.Left)
946 else if Result.LeftCount=Index then begin
947 fLastNode:=TIndexedAVLTreeNode(Result);
948 exit;
949 end
950 else begin
951 Index -= Result.LeftCount+1;
952 Result:=TIndexedAVLTreeNode(Result.Right);
953 end;
954 until false;
955 end;
956
NodeToIndexnull957 function TIndexedAVLTree.NodeToIndex(Node: TAvlTreeNode): SizeInt;
958 var
959 CurNode: TIndexedAVLTreeNode;
960 CurParent: TIndexedAVLTreeNode;
961 begin
962 if Node=nil then exit(-1);
963
964 if fLastNode=Node then
965 exit(fLastIndex);
966
967 CurNode:=TIndexedAVLTreeNode(Node);
968 Result:=CurNode.LeftCount;
969 repeat
970 CurParent:=TIndexedAVLTreeNode(CurNode.Parent);
971 if CurParent=nil then break;
972 if CurParent.Right=CurNode then
973 inc(Result,CurParent.LeftCount+1);
974 CurNode:=CurParent;
975 until false;
976
977 fLastNode:=TIndexedAVLTreeNode(Node);
978 fLastIndex:=Result;
979 end;
980
IndexOfnull981 function TIndexedAVLTree.IndexOf(Data: Pointer): SizeInt;
982 var
983 Node: TAvlTreeNode;
984 begin
985 Node:=FindPointer(Data);
986 if Node=nil then exit(-1);
987 Result:=NodeToIndex(Node);
988 end;
989
990 procedure TIndexedAVLTree.ConsistencyCheck;
991
992 procedure E(Msg: string);
993 begin
994 raise Exception.Create('TIndexedAVLTree.ConsistencyCheck: '+Msg);
995 end;
996
997 var
998 Node: TAvlTreeNode;
999 i: SizeInt;
1000 LeftCount: SizeInt;
1001 begin
1002 inherited ConsistencyCheck;
1003 i:=0;
1004 for Node in Self do begin
1005 if Node.Left<>nil then
1006 LeftCount:=Node.Left.GetCount
1007 else
1008 LeftCount:=0;
1009 if TIndexedAVLTreeNode(Node).LeftCount<>LeftCount then
1010 E(Format('Node.LeftCount=%d<>%d',[TIndexedAVLTreeNode(Node).LeftCount,LeftCount]));
1011
1012 if GetNodeAtIndex(i)<>Node then
1013 E(Format('GetNodeAtIndex(%d)<>%P',[i,Node]));
1014 fLastNode:=nil;
1015 if GetNodeAtIndex(i)<>Node then
1016 E(Format('GetNodeAtIndex(%d)<>%P',[i,Node]));
1017
1018 if NodeToIndex(Node)<>i then
1019 E(Format('NodeToIndex(%P)<>%d',[Node,i]));
1020 fLastNode:=nil;
1021 if NodeToIndex(Node)<>i then
1022 E(Format('NodeToIndex(%P)<>%d',[Node,i]));
1023
1024 inc(i);
1025 end;
1026 end;
1027
TIndexedAVLTree.NodeToReportStrnull1028 function TIndexedAVLTree.NodeToReportStr(aNode: TAvlTreeNode): string;
1029 begin
1030 Result:=inherited NodeToReportStr(aNode)+' LeftCount='+IntToStr(TIndexedAVLTreeNode(aNode).LeftCount);
1031 end;
1032
1033 { TPointerToPointerTree }
1034
GetCountnull1035 function TPointerToPointerTree.GetCount: SizeInt;
1036 begin
1037 Result:=FItems.Count;
1038 end;
1039
GetValuesnull1040 function TPointerToPointerTree.GetValues(const Key: Pointer): Pointer;
1041 var
1042 Node: TAvlTreeNode;
1043 begin
1044 Node:=FindNode(Key);
1045 if Node<>nil then
1046 Result:=PPointerToPointerItem(Node.Data)^.Value
1047 else
1048 Result:=nil;
1049 end;
1050
1051 procedure TPointerToPointerTree.SetValues(const Key: Pointer;
1052 const AValue: Pointer);
1053 var
1054 NewItem: PPointerToPointerItem;
1055 Node: TAvlTreeNode;
1056 begin
1057 Node:=FindNode(Key);
1058 if (Node<>nil) then
1059 PPointerToPointerItem(Node.Data)^.Value:=AValue
1060 else begin
1061 New(NewItem);
1062 NewItem^.Key:=Key;
1063 NewItem^.Value:=AValue;
1064 FItems.Add(NewItem);
1065 end;
1066 end;
1067
FindNodenull1068 function TPointerToPointerTree.FindNode(const Key: Pointer): TAvlTreeNode;
1069 begin
1070 Result:=FItems.FindKey(Key,@ComparePointerWithPtrToPtrItem)
1071 end;
1072
GetNodenull1073 function TPointerToPointerTree.GetNode(Node: TAvlTreeNode; out Key,Value: Pointer): Boolean;
1074 var
1075 Item: PPointerToPointerItem;
1076 begin
1077 if Node<>nil then begin
1078 Item:=PPointerToPointerItem(Node.Data);
1079 Key:=Item^.Key;
1080 Value:=Item^.Value;
1081 Result:=true;
1082 end else begin
1083 Key:=nil;
1084 Value:=nil;
1085 Result:=false;
1086 end;
1087 end;
1088
1089 constructor TPointerToPointerTree.Create;
1090 begin
1091 FItems:=TAvlTree.Create(@ComparePointerToPointerItems);
1092 end;
1093
1094 destructor TPointerToPointerTree.Destroy;
1095 begin
1096 Clear;
1097 FItems.Free;
1098 inherited Destroy;
1099 end;
1100
1101 procedure TPointerToPointerTree.Clear;
1102 var
1103 Node: TAvlTreeNode;
1104 Item: PPointerToPointerItem;
1105 begin
1106 Node:=FItems.FindLowest;
1107 while Node<>nil do begin
1108 Item:=PPointerToPointerItem(Node.Data);
1109 Dispose(Item);
1110 Node:=Node.Successor;
1111 end;
1112 FItems.Clear;
1113 end;
1114
1115 procedure TPointerToPointerTree.ClearWithFree;
1116 var
1117 Node: TAvlTreeNode;
1118 Item: PPointerToPointerItem;
1119 begin
1120 Node:=FItems.FindLowest;
1121 while Node<>nil do begin
1122 Item:=PPointerToPointerItem(Node.Data);
1123 TObject(Item^.Value).Free;
1124 Dispose(Item);
1125 Node:=Node.Successor;
1126 end;
1127 FItems.Clear;
1128 end;
1129
Equalsnull1130 function TPointerToPointerTree.Equals(Obj: TObject): boolean;
1131 begin
1132 if Obj is TPointerToPointerTree then
1133 Result:=IsEqual(TPointerToPointerTree(Obj))
1134 else
1135 Result:=inherited Equals(Obj);
1136 end;
1137
TPointerToPointerTree.IsEqualnull1138 function TPointerToPointerTree.IsEqual(aTree: TPointerToPointerTree): boolean;
1139 var
1140 MyNode: TAvlTreeNode;
1141 OtherNode: TAvlTreeNode;
1142 MyItem: PPointerToPointerItem;
1143 OtherItem: PPointerToPointerItem;
1144 begin
1145 if aTree=Self then exit(true);
1146 Result:=false;
1147 if aTree=nil then exit;
1148 if Count<>aTree.Count then exit;
1149 if FItems.OnCompare<>aTree.FItems.OnCompare then exit;
1150 if FItems.OnObjectCompare<>aTree.FItems.OnObjectCompare then exit;
1151 if FItems.NodeClass<>aTree.FItems.NodeClass then exit;
1152 MyNode:=FItems.FindLowest;
1153 OtherNode:=aTree.FItems.FindLowest;
1154 while MyNode<>nil do begin
1155 if OtherNode=nil then exit;
1156 MyItem:=PPointerToPointerItem(MyNode.Data);
1157 OtherItem:=PPointerToPointerItem(OtherNode.Data);
1158 if (MyItem^.Key<>OtherItem^.Key)
1159 or (MyItem^.Value<>OtherItem^.Value) then exit;
1160 MyNode:=MyNode.Successor;
1161 OtherNode:=OtherNode.Successor;
1162 end;
1163 if OtherNode<>nil then exit;
1164 Result:=true;
1165 end;
1166
1167 procedure TPointerToPointerTree.Assign(aTree: TPointerToPointerTree);
1168 var
1169 Node: TAvlTreeNode;
1170 SrcItem, MyItem: PPointerToPointerItem;
1171 begin
1172 if aTree=nil then
1173 raise Exception.Create('TPointerToPointerTree.Assign aTree=nil');
1174 if IsEqual(aTree) then exit;
1175 // clear and clone node structure, copying Data references
1176 FItems.Assign(aTree.FItems);
1177 // clone Data
1178 Node:=FItems.FindLowest;
1179 while Node<>nil do begin
1180 SrcItem:=PPointerToPointerItem(Node.Data);
1181 New(MyItem);
1182 MyItem^:=SrcItem^;
1183 Node.Data:=MyItem;
1184 Node:=Node.Successor;
1185 end;
1186 end;
1187
1188 procedure TPointerToPointerTree.Remove(Key: Pointer);
1189 var
1190 Node: TAvlTreeNode;
1191 Item: PPointerToPointerItem;
1192 begin
1193 Node:=FindNode(Key);
1194 if Node=nil then exit;
1195 Item:=PPointerToPointerItem(Node.Data);
1196 FItems.Delete(Node);
1197 Dispose(Item);
1198 end;
1199
TPointerToPointerTree.Containsnull1200 function TPointerToPointerTree.Contains(const Key: Pointer): Boolean;
1201 begin
1202 Result:=FindNode(Key)<>nil;
1203 end;
1204
TPointerToPointerTree.GetFirstnull1205 function TPointerToPointerTree.GetFirst(out Key, Value: Pointer): Boolean;
1206 begin
1207 Result:=GetNode(Tree.FindLowest,Key,Value);
1208 end;
1209
GetLastnull1210 function TPointerToPointerTree.GetLast(out Key, Value: Pointer): Boolean;
1211 begin
1212 Result:=GetNode(Tree.FindHighest,Key,Value);
1213 end;
1214
GetNextnull1215 function TPointerToPointerTree.GetNext(const Key: Pointer; out NextKey,
1216 NextValue: Pointer): Boolean;
1217 var
1218 Node: TAvlTreeNode;
1219 begin
1220 Node:=FindNode(Key);
1221 if Node<>nil then
1222 Node:=Node.Successor;
1223 Result:=GetNode(Node,NextKey,NextValue);
1224 end;
1225
TPointerToPointerTree.GetPrevnull1226 function TPointerToPointerTree.GetPrev(const Key: Pointer; out PrevKey,
1227 PrevValue: Pointer): Boolean;
1228 var
1229 Node: TAvlTreeNode;
1230 begin
1231 Node:=FindNode(Key);
1232 if Node<>nil then
1233 Node:=Node.Precessor;
1234 Result:=GetNode(Node,PrevKey,PrevValue);
1235 end;
1236
FindByValuenull1237 function TPointerToPointerTree.FindByValue(Value: Pointer): Pointer;
1238 // Find a Key by its Value using a slow linear search.
1239 var
1240 AVLNode: TAVLTreeNode;
1241 P2PItem: PPointerToPointerItem;
1242 begin
1243 AVLNode:=FItems.FindLowest;
1244 while AVLNode<>nil do begin
1245 P2PItem:=PPointerToPointerItem(AVLNode.Data);
1246 if Value = P2PItem^.Value then
1247 Exit(P2PItem^.Key);
1248 AVLNode:=FItems.FindSuccessor(AVLNode);
1249 end;
1250 Result:=nil;
1251 end;
1252
GetEnumeratornull1253 function TPointerToPointerTree.GetEnumerator: TPointerToPointerEnumerator;
1254 begin
1255 Result:=TPointerToPointerEnumerator.Create(Tree);
1256 end;
1257
GetEnumeratorHighToLownull1258 function TPointerToPointerTree.GetEnumeratorHighToLow: TPointerToPointerEnumerator;
1259 begin
1260 Result:=TPointerToPointerEnumerator.Create(Tree);
1261 Result.fHighToLow:=true;
1262 end;
1263
1264 { TCustomStringMapEnumerator }
1265
1266 constructor TCustomStringMapEnumerator.Create(Tree: TAvlTree);
1267 begin
1268 FTree:=Tree;
1269 end;
1270
TCustomStringMapEnumerator.MoveNextnull1271 function TCustomStringMapEnumerator.MoveNext: boolean;
1272 begin
1273 if FCurrent=nil then
1274 FCurrent:=FTree.FindLowest
1275 else
1276 FCurrent:=FCurrent.Successor;
1277 Result:=FCurrent<>nil;
1278 end;
1279
1280 { TCustomStringMap }
1281
TCustomStringMap.GetCompareItemsFuncnull1282 function TCustomStringMap.GetCompareItemsFunc: TListSortCompare;
1283 begin
1284 Result:=Tree.OnCompare;
1285 end;
1286
FindNodenull1287 function TCustomStringMap.FindNode(const s: string): TAvlTreeNode;
1288 begin
1289 Result:=FTree.FindKey(Pointer(s),FCompareKeyItemFunc);
1290 end;
1291
1292 procedure TCustomStringMap.DisposeItem(p: PStringMapItem);
1293 begin
1294 Dispose(p);
1295 end;
1296
TCustomStringMap.ItemsAreEqualnull1297 function TCustomStringMap.ItemsAreEqual(p1, p2: PStringMapItem): boolean;
1298 begin
1299 Result:=p1^.Name=p2^.Name;
1300 end;
1301
TCustomStringMap.CreateCopynull1302 function TCustomStringMap.CreateCopy(Src: PStringMapItem): PStringMapItem;
1303 begin
1304 New(Result);
1305 Result^.Name:=Src^.Name;
1306 end;
1307
1308 constructor TCustomStringMap.Create(TheCaseSensitive: boolean);
1309 begin
1310 if TheCaseSensitive then
1311 Create(@CompareStringToStringItems,@CompareAnsiStringWithStrToStrItem,true)
1312 else
1313 Create(@CompareStringToStringItemsI,@CompareAnsiStringWithStrToStrItemI,false);
1314 end;
1315
1316 constructor TCustomStringMap.Create(const ACompareItems,
1317 ACompareNameWithItem: TListSortCompare; TheCaseSensitive: boolean);
1318 begin
1319 FCaseSensitive:=TheCaseSensitive;
1320 FCompareKeyItemFunc:=ACompareNameWithItem;
1321 FTree:=TAvlTree.Create(ACompareItems);
1322 FTree.SetNodeManager(nil);
1323 end;
1324
1325 destructor TCustomStringMap.Destroy;
1326 begin
1327 Clear;
1328 FTree.Free;
1329 FTree:=nil;
1330 inherited Destroy;
1331 end;
1332
1333 procedure TCustomStringMap.Clear;
1334 var
1335 Node: TAvlTreeNode;
1336 begin
1337 Node:=FTree.FindLowest;
1338 while Node<>nil do begin
1339 DisposeItem(PStringMapItem(Node.Data));
1340 Node:=Node.Successor;
1341 end;
1342 FTree.Clear;
1343 end;
1344
Containsnull1345 function TCustomStringMap.Contains(const s: string): boolean;
1346 begin
1347 Result:=FindNode(s)<>nil;
1348 end;
1349
1350 procedure TCustomStringMap.GetNames(List: TStrings);
1351 var
1352 Node: TAvlTreeNode;
1353 Item: PStringMapItem;
1354 begin
1355 Node:=Tree.FindLowest;
1356 while Node<>nil do begin
1357 Item:=PStringMapItem(Node.Data);
1358 List.Add(Item^.Name);
1359 Node:=Node.Successor;
1360 end;
1361 end;
1362
1363 procedure TCustomStringMap.Remove(const Name: string);
1364 var
1365 Node: TAvlTreeNode;
1366 Item: PStringMapItem;
1367 begin
1368 Node:=FindNode(Name);
1369 if Node<>nil then begin
1370 Item:=PStringMapItem(Node.Data);
1371 FTree.Delete(Node);
1372 Dispose(Item);
1373 end;
1374 end;
1375
TCustomStringMap.Countnull1376 function TCustomStringMap.Count: SizeInt;
1377 begin
1378 Result:=Tree.Count;
1379 end;
1380
Equalsnull1381 function TCustomStringMap.Equals(OtherTree: TCustomStringMap): boolean;
1382 var
1383 Node: TAvlTreeNode;
1384 OtherNode: TAvlTreeNode;
1385 OtherItem: PStringMapItem;
1386 Item: PStringMapItem;
1387 begin
1388 Result:=false;
1389 if (OtherTree=nil) or (OtherTree.ClassType<>ClassType) then exit;
1390 if Tree.Count<>OtherTree.Tree.Count then exit;
1391 Node:=Tree.FindLowest;
1392 OtherNode:=OtherTree.Tree.FindLowest;
1393 while Node<>nil do begin
1394 if OtherNode=nil then exit;
1395 Item:=PStringMapItem(Node.Data);
1396 OtherItem:=PStringMapItem(OtherNode.Data);
1397 if not ItemsAreEqual(Item,OtherItem) then exit;
1398 OtherNode:=OtherNode.Successor;
1399 Node:=Node.Successor;
1400 end;
1401 if OtherNode<>nil then exit;
1402 Result:=true;
1403 end;
1404
1405 procedure TCustomStringMap.Assign(Source: TCustomStringMap);
1406 var
1407 SrcNode: TAvlTreeNode;
1408 SrcItem: PStringMapItem;
1409 begin
1410 if (Source=nil) or (Source.ClassType<>ClassType) then
1411 raise Exception.Create('invalid class');
1412 Clear;
1413 SrcNode:=Source.Tree.FindLowest;
1414 while SrcNode<>nil do begin
1415 SrcItem:=PStringMapItem(SrcNode.Data);
1416 Tree.Add(CreateCopy(SrcItem));
1417 SrcNode:=SrcNode.Successor;
1418 end;
1419 end;
1420
CalcMemSizenull1421 function TCustomStringMap.CalcMemSize: PtrUint;
1422 var
1423 Node: TAvlTreeNode;
1424 Item: PStringMapItem;
1425 begin
1426 Result:=PtrUInt(InstanceSize)
1427 +PtrUInt(FTree.InstanceSize)
1428 +PtrUint(FTree.Count)*SizeOf(TAvlTreeNode);
1429 Node:=FTree.FindLowest;
1430 while Node<>nil do begin
1431 Item:=PStringMapItem(Node.Data);
1432 inc(Result,MemSizeString(Item^.Name)
1433 +SizeOf(TStringMapItem));
1434 Node:=FTree.FindSuccessor(Node);
1435 end;
1436 end;
1437
1438 procedure TCustomStringMap.SetCompareFuncs(const NewCompareItemsFunc,
1439 NewCompareKeyItemFunc: TListSortCompare {; NewCaseSensitive: boolean});
1440 begin
1441 FCompareKeyItemFunc:=NewCompareKeyItemFunc;
1442 Tree.OnCompare:=NewCompareItemsFunc;
1443 //FCaseSensitive:=NewCaseSensitive;
1444 end;
1445
1446 end.
1447