← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to lcl/avglvltree.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lcl/avglvltree.pas
1
 
{
2
 
 *****************************************************************************
3
 
 *                                                                           *
4
 
 *  This file is part of the Lazarus Component Library (LCL)                 *
5
 
 *                                                                           *
6
 
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
7
 
 *  for details about the copyright.                                         *
8
 
 *                                                                           *
9
 
 *  This program is distributed in the hope that it will be useful,          *
10
 
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
11
 
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
12
 
 *                                                                           *
13
 
 *****************************************************************************
14
 
 
15
 
  Author: Mattias Gaertner
16
 
  
17
 
  Abstract:
18
 
    The Tree is sorted ascending from left to right. That means Compare gives
19
 
    positive values for comparing right with left.
20
 
  
21
 
    TAvgLvlTree is an Average Level binary Tree. This binary tree is always
22
 
    balanced, so that inserting, deleting and finding a node is performed in
23
 
    O(log(#Nodes)).
24
 
 
25
 
    Tree is sorted ascending.
26
 
}
27
 
unit AvgLvlTree;
28
 
 
29
 
{$mode objfpc}{$H+}
30
 
 
31
 
interface
32
 
 
33
 
uses
34
 
  Classes, SysUtils, FPCAdds;
35
 
 
36
 
type
37
 
  TAvgLvlTree = class;
38
 
  
39
 
  TObjectSortCompare = function(Tree: TAvgLvlTree; Data1, Data2: Pointer
40
 
                                ): integer of object;
41
 
 
42
 
  TAvgLvlTreeNode = class
43
 
  public
44
 
    Parent, Left, Right: TAvgLvlTreeNode;
45
 
    Balance: integer;
46
 
    Data: Pointer;
47
 
    procedure Clear;
48
 
    function TreeDepth: integer; // longest WAY down. e.g. only one node => 0 !
49
 
  end;
50
 
  PAvgLvlTreeNode = ^TAvgLvlTreeNode;
51
 
 
52
 
  TAvgLvlTreeNodeMemManager = class;
53
 
 
54
 
  { TAvgLvlTree }
55
 
 
56
 
  TAvgLvlTree = class
57
 
  private
58
 
    FCount: integer;
59
 
    FNodeMemManager: TAvgLvlTreeNodeMemManager;
60
 
    FOnCompare: TListSortCompare;
61
 
    FOnObjectCompare: TObjectSortCompare;
62
 
    procedure BalanceAfterInsert(ANode: TAvgLvlTreeNode);
63
 
    procedure BalanceAfterDelete(ANode: TAvgLvlTreeNode);
64
 
    function FindInsertPos(Data: Pointer): TAvgLvlTreeNode;
65
 
    procedure SetOnCompare(const AValue: TListSortCompare);
66
 
    procedure SetOnObjectCompare(const AValue: TObjectSortCompare);
67
 
    procedure SetCompares(const NewCompare: TListSortCompare;
68
 
                          const NewObjectCompare: TObjectSortCompare);
69
 
  public
70
 
    Root: TAvgLvlTreeNode;
71
 
    function Compare(Data1, Data2: Pointer): integer;
72
 
    function Find(Data: Pointer): TAvgLvlTreeNode;
73
 
    function FindKey(Key: Pointer;
74
 
                     OnCompareKeyWithData: TListSortCompare): TAvgLvlTreeNode;
75
 
    function FindNearestKey(Key: Pointer;
76
 
                       OnCompareKeyWithData: TListSortCompare): TAvgLvlTreeNode;
77
 
    function FindSuccessor(ANode: TAvgLvlTreeNode): TAvgLvlTreeNode;
78
 
    function FindPrecessor(ANode: TAvgLvlTreeNode): TAvgLvlTreeNode;
79
 
    function FindLowest: TAvgLvlTreeNode;
80
 
    function FindHighest: TAvgLvlTreeNode;
81
 
    function FindNearest(Data: Pointer): TAvgLvlTreeNode;
82
 
    function FindPointer(Data: Pointer): TAvgLvlTreeNode;
83
 
    function FindLeftMost(Data: Pointer): TAvgLvlTreeNode;
84
 
    function FindRightMost(Data: Pointer): TAvgLvlTreeNode;
85
 
    function FindLeftMostKey(Key: Pointer;
86
 
                       OnCompareKeyWithData: TListSortCompare): TAvgLvlTreeNode;
87
 
    function FindRightMostKey(Key: Pointer;
88
 
                       OnCompareKeyWithData: TListSortCompare): TAvgLvlTreeNode;
89
 
    function FindLeftMostSameKey(ANode: TAvgLvlTreeNode): TAvgLvlTreeNode;
90
 
    function FindRightMostSameKey(ANode: TAvgLvlTreeNode): TAvgLvlTreeNode;
91
 
    procedure Add(ANode: TAvgLvlTreeNode);
92
 
    function Add(Data: Pointer): TAvgLvlTreeNode;
93
 
    procedure Delete(ANode: TAvgLvlTreeNode);
94
 
    procedure Remove(Data: Pointer);
95
 
    procedure RemovePointer(Data: Pointer);
96
 
    procedure MoveDataLeftMost(var ANode: TAvgLvlTreeNode);
97
 
    procedure MoveDataRightMost(var ANode: TAvgLvlTreeNode);
98
 
    property OnCompare: TListSortCompare read FOnCompare write SetOnCompare;
99
 
    property OnObjectCompare: TObjectSortCompare read FOnObjectCompare write SetOnObjectCompare;
100
 
    procedure Clear;
101
 
    procedure FreeAndClear;
102
 
    procedure FreeAndDelete(ANode: TAvgLvlTreeNode);
103
 
    property Count: integer read FCount;
104
 
    function ConsistencyCheck: integer;
105
 
    procedure WriteReportToStream(s: TStream; var StreamSize: TStreamSeekType);
106
 
    function ReportAsString: string;
107
 
    property NodeMemManager: TAvgLvlTreeNodeMemManager read FNodeMemManager write FNodeMemManager;
108
 
    constructor Create(OnCompareMethod: TListSortCompare);
109
 
    constructor CreateObjectCompare(OnCompareMethod: TObjectSortCompare);
110
 
    constructor Create;
111
 
    destructor Destroy; override;
112
 
  end;
113
 
  PAvgLvlTree = ^TAvgLvlTree;
114
 
 
115
 
  TAvgLvlTreeNodeMemManager = class
116
 
  private
117
 
    FFirstFree: TAvgLvlTreeNode;
118
 
    FFreeCount: integer;
119
 
    FCount: integer;
120
 
    FMinFree: integer;
121
 
    FMaxFreeRatio: integer;
122
 
    procedure SetMaxFreeRatio(NewValue: integer);
123
 
    procedure SetMinFree(NewValue: integer);
124
 
    procedure DisposeFirstFreeNode;
125
 
  public
126
 
    procedure DisposeNode(ANode: TAvgLvlTreeNode);
127
 
    function NewNode: TAvgLvlTreeNode;
128
 
    property MinimumFreeNode: integer read FMinFree write SetMinFree;
129
 
    property MaximumFreeNodeRatio: integer
130
 
                read FMaxFreeRatio write SetMaxFreeRatio; // in one eighth steps
131
 
    property Count: integer read FCount;
132
 
    procedure Clear;
133
 
    constructor Create;
134
 
    destructor Destroy; override;
135
 
  end;
136
 
 
137
 
 
138
 
type
139
 
  { TPointerToPointerTree - Associative array }
140
 
 
141
 
  TPointerToPointerItem = record
142
 
    Key: Pointer;
143
 
    Value: Pointer;
144
 
  end;
145
 
  PPointerToPointerItem = ^TPointerToPointerItem;
146
 
 
147
 
  TPointerToPointerTree = class
148
 
  private
149
 
    FItems: TAvgLvlTree;
150
 
    function GetCount: Integer;
151
 
    function GetValues(const Key: Pointer): Pointer;
152
 
    procedure SetValues(const Key: Pointer; const AValue: Pointer);
153
 
    function FindNode(const Key: Pointer): TAvgLvlTreeNode;
154
 
    function GetNode(Node: TAvgLvlTreeNode; out Key, Value: Pointer): Boolean;
155
 
  public
156
 
    constructor Create;
157
 
    destructor Destroy; override;
158
 
    procedure Clear;
159
 
    procedure Remove(Key: Pointer);
160
 
    function Contains(const Key: Pointer): Boolean;
161
 
    function GetFirst(out Key, Value: Pointer): Boolean;
162
 
    function GetLast(out Key, Value: Pointer): Boolean;
163
 
    function GetNext(const Key: Pointer; out NextKey, NextValue: Pointer): Boolean;
164
 
    function GetPrev(const Key: Pointer; out PrevKey, PrevValue: Pointer): Boolean;
165
 
    property Count: Integer read GetCount;
166
 
    property Values[const Key: Pointer]: Pointer read GetValues write SetValues; default;
167
 
    property Tree: TAvgLvlTree read FItems;
168
 
  end;
169
 
 
170
 
 
171
 
function ComparePointerToPointerItems(Data1, Data2: Pointer): integer;
172
 
function ComparePointerWithPtrToPtrItem(Key, Data: Pointer): Integer;
173
 
 
174
 
 
175
 
type
176
 
  { TStringToStringTree - Associative array }
177
 
 
178
 
  TStringToStringItem = record
179
 
    Name: string;
180
 
    Value: string;
181
 
  end;
182
 
  PStringToStringItem = ^TStringToStringItem;
183
 
 
184
 
  TStringToStringTree = class
185
 
  private
186
 
    FCompareItems: TListSortCompare;
187
 
    FCompareNameWithItem: TListSortCompare;
188
 
    FItems: TAvgLvlTree;
189
 
    function GetCount: Integer;
190
 
    function GetValues(const Name: string): string;
191
 
    procedure SetValues(const Name: string; const AValue: string);
192
 
    function FindNode(const Name: string): TAvgLvlTreeNode;
193
 
    function GetNode(Node: TAvgLvlTreeNode; out Name, Value: string): Boolean;
194
 
  public
195
 
    constructor Create(CaseSensitive: boolean);
196
 
    constructor Create(const ACompareItems, ACompareNameWithItem: TListSortCompare);
197
 
    destructor Destroy; override;
198
 
    procedure Clear;
199
 
    procedure Assign(Src: TStringToStringTree);
200
 
    function Contains(const Name: string): Boolean;
201
 
    procedure Delete(const Name: string);
202
 
    procedure Add(const Name, Value, Delimiter: string);
203
 
    procedure AddNameValues(List: TStrings);
204
 
    procedure AddValues(List: TStrings);
205
 
    function GetFirst(out Name, Value: string): Boolean;
206
 
    function GetLast(out Name, Value: string): Boolean;
207
 
    function GetNext(const Name: string; out NextName, NextValue: string): Boolean;
208
 
    function GetPrev(const Name: string; out PrevName, PrevValue: string): Boolean;
209
 
    property Count: Integer read GetCount;
210
 
    property Values[const Name: string]: string read GetValues write SetValues; default;
211
 
    property Tree: TAvgLvlTree read FItems;
212
 
    property CompareItems: TListSortCompare read FCompareItems;
213
 
    property CompareNameWithItem: TListSortCompare read FCompareNameWithItem;
214
 
  end;
215
 
 
216
 
function CompareStringToStringItems(Data1, Data2: Pointer): integer;
217
 
function ComparePAnsiStringWithStrToStrItem(Key, Data: Pointer): Integer;
218
 
function CompareStringToStringItemsI(Data1, Data2: Pointer): integer;
219
 
function ComparePAnsiStringWithStrToStrItemI(Key, Data: Pointer): Integer;
220
 
 
221
 
 
222
 
implementation
223
 
 
224
 
 
225
 
function ComparePointer(Data1, Data2: Pointer): integer;
226
 
begin
227
 
  if Data1>Data2 then Result:=-1
228
 
  else if Data1<Data2 then Result:=1
229
 
  else Result:=0;
230
 
end;
231
 
 
232
 
function ComparePointerToPointerItems(Data1, Data2: Pointer): integer;
233
 
begin
234
 
  Result:=ComparePointer(PPointerToPointerItem(Data1)^.Key,
235
 
                         PPointerToPointerItem(Data2)^.Key);
236
 
end;
237
 
 
238
 
function ComparePointerWithPtrToPtrItem(Key, Data: Pointer): Integer;
239
 
begin
240
 
  Result:=ComparePointer(Key,PPointerToPointerItem(Data)^.Key);
241
 
end;
242
 
 
243
 
function CompareStringToStringItems(Data1, Data2: Pointer): integer;
244
 
begin
245
 
  Result:=CompareStr(PStringToStringItem(Data1)^.Name,
246
 
                     PStringToStringItem(Data2)^.Name);
247
 
end;
248
 
 
249
 
function CompareStringToStringItemsI(Data1, Data2: Pointer): integer;
250
 
begin
251
 
  Result:=CompareText(PStringToStringItem(Data1)^.Name,
252
 
                      PStringToStringItem(Data2)^.Name);
253
 
end;
254
 
 
255
 
function ComparePAnsiStringWithStrToStrItem(Key, Data: Pointer): Integer;
256
 
begin
257
 
  Result:=CompareStr(PAnsiString(Key)^,PStringToStringItem(Data)^.Name);
258
 
end;
259
 
 
260
 
function ComparePAnsiStringWithStrToStrItemI(Key, Data: Pointer): Integer;
261
 
begin
262
 
  Result:=CompareText(PAnsiString(Key)^,PStringToStringItem(Data)^.Name);
263
 
end;
264
 
 
265
 
 
266
 
{ TAvgLvlTree }
267
 
 
268
 
function TAvgLvlTree.Add(Data: Pointer): TAvgLvlTreeNode;
269
 
begin
270
 
  if NodeMemManager<>nil then
271
 
    Result:=NodeMemManager.NewNode
272
 
  else
273
 
    Result:=TAvgLvlTreeNode.Create;
274
 
  Result.Data:=Data;
275
 
  Add(Result);
276
 
end;
277
 
 
278
 
procedure TAvgLvlTree.Add(ANode: TAvgLvlTreeNode);
279
 
// add a node. If there are already nodes with the same value it will be
280
 
// inserted rightmost
281
 
var InsertPos: TAvgLvlTreeNode;
282
 
  InsertComp: integer;
283
 
begin
284
 
  ANode.Left:=nil;
285
 
  ANode.Right:=nil;
286
 
  inc(FCount);
287
 
  if Root<>nil then begin
288
 
    InsertPos:=FindInsertPos(ANode.Data);
289
 
    InsertComp:=Compare(ANode.Data,InsertPos.Data);
290
 
    ANode.Parent:=InsertPos;
291
 
    if InsertComp<0 then begin
292
 
      // insert to the left
293
 
      InsertPos.Left:=ANode;
294
 
    end else begin
295
 
      // insert to the right
296
 
      InsertPos.Right:=ANode;
297
 
    end;
298
 
    BalanceAfterInsert(ANode);
299
 
  end else begin
300
 
    Root:=ANode;
301
 
    ANode.Parent:=nil;
302
 
  end;
303
 
end;
304
 
 
305
 
function TAvgLvlTree.FindLowest: TAvgLvlTreeNode;
306
 
begin
307
 
  Result:=Root;
308
 
  if Result<>nil then
309
 
    while Result.Left<>nil do Result:=Result.Left;
310
 
end;
311
 
 
312
 
function TAvgLvlTree.FindHighest: TAvgLvlTreeNode;
313
 
begin
314
 
  Result:=Root;
315
 
  if Result<>nil then
316
 
    while Result.Right<>nil do Result:=Result.Right;
317
 
end;
318
 
    
319
 
procedure TAvgLvlTree.BalanceAfterDelete(ANode: TAvgLvlTreeNode);
320
 
var OldParent, OldRight, OldRightLeft, OldLeft, OldLeftRight,
321
 
  OldRightLeftLeft, OldRightLeftRight, OldLeftRightLeft, OldLeftRightRight
322
 
  : TAvgLvlTreeNode;
323
 
begin
324
 
  if (ANode=nil) then exit;
325
 
  if ((ANode.Balance=+1) or (ANode.Balance=-1)) then exit;
326
 
  OldParent:=ANode.Parent;
327
 
  if (ANode.Balance=0) then begin
328
 
    // Treeheight has decreased by one
329
 
    if (OldParent<>nil) then begin
330
 
      if(OldParent.Left=ANode) then
331
 
        Inc(OldParent.Balance)
332
 
      else
333
 
        Dec(OldParent.Balance);
334
 
      BalanceAfterDelete(OldParent);
335
 
    end;
336
 
    exit;
337
 
  end;
338
 
  if (ANode.Balance=+2) then begin
339
 
    // Node is overweighted to the right
340
 
    OldRight:=ANode.Right;
341
 
    if (OldRight.Balance>=0) then begin
342
 
      // OldRight.Balance=={0 or -1}
343
 
      // rotate left
344
 
      OldRightLeft:=OldRight.Left;
345
 
      if (OldParent<>nil) then begin
346
 
        if (OldParent.Left=ANode) then
347
 
          OldParent.Left:=OldRight
348
 
        else
349
 
          OldParent.Right:=OldRight;
350
 
      end else
351
 
        Root:=OldRight;
352
 
      ANode.Parent:=OldRight;
353
 
      ANode.Right:=OldRightLeft;
354
 
      OldRight.Parent:=OldParent;
355
 
      OldRight.Left:=ANode;
356
 
      if (OldRightLeft<>nil) then
357
 
        OldRightLeft.Parent:=ANode;
358
 
      ANode.Balance:=(1-OldRight.Balance);
359
 
      Dec(OldRight.Balance);
360
 
      BalanceAfterDelete(OldRight);
361
 
    end else begin
362
 
      // OldRight.Balance=-1
363
 
      // double rotate right left
364
 
      OldRightLeft:=OldRight.Left;
365
 
      OldRightLeftLeft:=OldRightLeft.Left;
366
 
      OldRightLeftRight:=OldRightLeft.Right;
367
 
      if (OldParent<>nil) then begin
368
 
        if (OldParent.Left=ANode) then
369
 
          OldParent.Left:=OldRightLeft
370
 
        else
371
 
          OldParent.Right:=OldRightLeft;
372
 
      end else
373
 
        Root:=OldRightLeft;
374
 
      ANode.Parent:=OldRightLeft;
375
 
      ANode.Right:=OldRightLeftLeft;
376
 
      OldRight.Parent:=OldRightLeft;
377
 
      OldRight.Left:=OldRightLeftRight;
378
 
      OldRightLeft.Parent:=OldParent;
379
 
      OldRightLeft.Left:=ANode;
380
 
      OldRightLeft.Right:=OldRight;
381
 
      if (OldRightLeftLeft<>nil) then
382
 
        OldRightLeftLeft.Parent:=ANode;
383
 
      if (OldRightLeftRight<>nil) then
384
 
        OldRightLeftRight.Parent:=OldRight;
385
 
      if (OldRightLeft.Balance<=0) then
386
 
        ANode.Balance:=0
387
 
      else
388
 
        ANode.Balance:=-1;
389
 
      if (OldRightLeft.Balance>=0) then
390
 
        OldRight.Balance:=0
391
 
      else
392
 
        OldRight.Balance:=+1;
393
 
      OldRightLeft.Balance:=0;
394
 
      BalanceAfterDelete(OldRightLeft);
395
 
    end;
396
 
  end else begin
397
 
    // Node.Balance=-2
398
 
    // Node is overweighted to the left
399
 
    OldLeft:=ANode.Left;
400
 
    if (OldLeft.Balance<=0) then begin
401
 
      // rotate right
402
 
      OldLeftRight:=OldLeft.Right;
403
 
      if (OldParent<>nil) then begin
404
 
        if (OldParent.Left=ANode) then
405
 
          OldParent.Left:=OldLeft
406
 
        else
407
 
          OldParent.Right:=OldLeft;
408
 
      end else
409
 
        Root:=OldLeft;
410
 
      ANode.Parent:=OldLeft;
411
 
      ANode.Left:=OldLeftRight;
412
 
      OldLeft.Parent:=OldParent;
413
 
      OldLeft.Right:=ANode;
414
 
      if (OldLeftRight<>nil) then
415
 
        OldLeftRight.Parent:=ANode;
416
 
      ANode.Balance:=(-1-OldLeft.Balance);
417
 
      Inc(OldLeft.Balance);
418
 
      BalanceAfterDelete(OldLeft);
419
 
    end else begin
420
 
      // OldLeft.Balance = 1
421
 
      // double rotate left right
422
 
      OldLeftRight:=OldLeft.Right;
423
 
      OldLeftRightLeft:=OldLeftRight.Left;
424
 
      OldLeftRightRight:=OldLeftRight.Right;
425
 
      if (OldParent<>nil) then begin
426
 
        if (OldParent.Left=ANode) then
427
 
          OldParent.Left:=OldLeftRight
428
 
        else
429
 
          OldParent.Right:=OldLeftRight;
430
 
      end else
431
 
        Root:=OldLeftRight;
432
 
      ANode.Parent:=OldLeftRight;
433
 
      ANode.Left:=OldLeftRightRight;
434
 
      OldLeft.Parent:=OldLeftRight;
435
 
      OldLeft.Right:=OldLeftRightLeft;
436
 
      OldLeftRight.Parent:=OldParent;
437
 
      OldLeftRight.Left:=OldLeft;
438
 
      OldLeftRight.Right:=ANode;
439
 
      if (OldLeftRightLeft<>nil) then
440
 
        OldLeftRightLeft.Parent:=OldLeft;
441
 
      if (OldLeftRightRight<>nil) then
442
 
        OldLeftRightRight.Parent:=ANode;
443
 
      if (OldLeftRight.Balance>=0) then
444
 
        ANode.Balance:=0
445
 
      else
446
 
        ANode.Balance:=+1;
447
 
      if (OldLeftRight.Balance<=0) then
448
 
        OldLeft.Balance:=0
449
 
      else
450
 
        OldLeft.Balance:=-1;
451
 
      OldLeftRight.Balance:=0;
452
 
      BalanceAfterDelete(OldLeftRight);
453
 
    end;
454
 
  end;
455
 
end;
456
 
 
457
 
procedure TAvgLvlTree.BalanceAfterInsert(ANode: TAvgLvlTreeNode);
458
 
var OldParent, OldParentParent, OldRight, OldRightLeft, OldRightRight, OldLeft,
459
 
   OldLeftLeft, OldLeftRight: TAvgLvlTreeNode;
460
 
begin
461
 
  OldParent:=ANode.Parent;
462
 
  if (OldParent=nil) then exit;
463
 
  if (OldParent.Left=ANode) then begin
464
 
    // Node is left son
465
 
    dec(OldParent.Balance);
466
 
    if (OldParent.Balance=0) then exit;
467
 
    if (OldParent.Balance=-1) then begin
468
 
      BalanceAfterInsert(OldParent);
469
 
      exit;
470
 
    end;
471
 
    // OldParent.Balance=-2
472
 
    if (ANode.Balance=-1) then begin
473
 
      // rotate
474
 
      OldRight:=ANode.Right;
475
 
      OldParentParent:=OldParent.Parent;
476
 
      if (OldParentParent<>nil) then begin
477
 
        // OldParent has GrandParent. GrandParent gets new child
478
 
        if (OldParentParent.Left=OldParent) then
479
 
          OldParentParent.Left:=ANode
480
 
        else
481
 
          OldParentParent.Right:=ANode;
482
 
      end else begin
483
 
        // OldParent was root node. New root node
484
 
        Root:=ANode;
485
 
      end;
486
 
      ANode.Parent:=OldParentParent;
487
 
      ANode.Right:=OldParent;
488
 
      OldParent.Parent:=ANode;
489
 
      OldParent.Left:=OldRight;
490
 
      if (OldRight<>nil) then
491
 
        OldRight.Parent:=OldParent;
492
 
      ANode.Balance:=0;
493
 
      OldParent.Balance:=0;
494
 
    end else begin
495
 
      // Node.Balance = +1
496
 
      // double rotate
497
 
      OldParentParent:=OldParent.Parent;
498
 
      OldRight:=ANode.Right;
499
 
      OldRightLeft:=OldRight.Left;
500
 
      OldRightRight:=OldRight.Right;
501
 
      if (OldParentParent<>nil) then begin
502
 
        // OldParent has GrandParent. GrandParent gets new child
503
 
        if (OldParentParent.Left=OldParent) then
504
 
          OldParentParent.Left:=OldRight
505
 
        else
506
 
          OldParentParent.Right:=OldRight;
507
 
      end else begin
508
 
        // OldParent was root node. new root node
509
 
        Root:=OldRight;
510
 
      end;
511
 
      OldRight.Parent:=OldParentParent;
512
 
      OldRight.Left:=ANode;
513
 
      OldRight.Right:=OldParent;
514
 
      ANode.Parent:=OldRight;
515
 
      ANode.Right:=OldRightLeft;
516
 
      OldParent.Parent:=OldRight;
517
 
      OldParent.Left:=OldRightRight;
518
 
      if (OldRightLeft<>nil) then
519
 
        OldRightLeft.Parent:=ANode;
520
 
      if (OldRightRight<>nil) then
521
 
        OldRightRight.Parent:=OldParent;
522
 
      if (OldRight.Balance<=0) then
523
 
        ANode.Balance:=0
524
 
      else
525
 
        ANode.Balance:=-1;
526
 
      if (OldRight.Balance=-1) then
527
 
        OldParent.Balance:=1
528
 
      else
529
 
        OldParent.Balance:=0;
530
 
      OldRight.Balance:=0;
531
 
    end;
532
 
  end else begin
533
 
    // Node is right son
534
 
    Inc(OldParent.Balance);
535
 
    if (OldParent.Balance=0) then exit;
536
 
    if (OldParent.Balance=+1) then begin
537
 
      BalanceAfterInsert(OldParent);
538
 
      exit;
539
 
    end;
540
 
    // OldParent.Balance = +2
541
 
    if(ANode.Balance=+1) then begin
542
 
      // rotate
543
 
      OldLeft:=ANode.Left;
544
 
      OldParentParent:=OldParent.Parent;
545
 
      if (OldParentParent<>nil) then begin
546
 
        // Parent has GrandParent . GrandParent gets new child
547
 
        if(OldParentParent.Left=OldParent) then
548
 
          OldParentParent.Left:=ANode
549
 
        else
550
 
          OldParentParent.Right:=ANode;
551
 
      end else begin
552
 
        // OldParent was root node . new root node
553
 
        Root:=ANode;
554
 
      end;
555
 
      ANode.Parent:=OldParentParent;
556
 
      ANode.Left:=OldParent;
557
 
      OldParent.Parent:=ANode;
558
 
      OldParent.Right:=OldLeft;
559
 
      if (OldLeft<>nil) then
560
 
        OldLeft.Parent:=OldParent;
561
 
      ANode.Balance:=0;
562
 
      OldParent.Balance:=0;
563
 
    end else begin
564
 
      // Node.Balance = -1
565
 
      // double rotate
566
 
      OldLeft:=ANode.Left;
567
 
      OldParentParent:=OldParent.Parent;
568
 
      OldLeftLeft:=OldLeft.Left;
569
 
      OldLeftRight:=OldLeft.Right;
570
 
      if (OldParentParent<>nil) then begin
571
 
        // OldParent has GrandParent . GrandParent gets new child
572
 
        if (OldParentParent.Left=OldParent) then
573
 
          OldParentParent.Left:=OldLeft
574
 
        else
575
 
          OldParentParent.Right:=OldLeft;
576
 
      end else begin
577
 
        // OldParent was root node . new root node
578
 
        Root:=OldLeft;
579
 
      end;
580
 
      OldLeft.Parent:=OldParentParent;
581
 
      OldLeft.Left:=OldParent;
582
 
      OldLeft.Right:=ANode;
583
 
      ANode.Parent:=OldLeft;
584
 
      ANode.Left:=OldLeftRight;
585
 
      OldParent.Parent:=OldLeft;
586
 
      OldParent.Right:=OldLeftLeft;
587
 
      if (OldLeftLeft<>nil) then
588
 
        OldLeftLeft.Parent:=OldParent;
589
 
      if (OldLeftRight<>nil) then
590
 
        OldLeftRight.Parent:=ANode;
591
 
      if (OldLeft.Balance>=0) then
592
 
        ANode.Balance:=0
593
 
      else
594
 
        ANode.Balance:=+1;
595
 
      if (OldLeft.Balance=+1) then
596
 
        OldParent.Balance:=-1
597
 
      else
598
 
        OldParent.Balance:=0;
599
 
      OldLeft.Balance:=0;
600
 
    end;
601
 
  end;
602
 
end;
603
 
 
604
 
procedure TAvgLvlTree.Clear;
605
 
 
606
 
  procedure DeleteNode(ANode: TAvgLvlTreeNode);
607
 
  begin
608
 
    if ANode<>nil then begin
609
 
      if ANode.Left<>nil then DeleteNode(ANode.Left);
610
 
      if ANode.Right<>nil then DeleteNode(ANode.Right);
611
 
    end;
612
 
    if NodeMemManager<>nil then
613
 
      NodeMemManager.DisposeNode(ANode)
614
 
    else
615
 
      ANode.Free;
616
 
  end;
617
 
 
618
 
// Clear
619
 
begin
620
 
  DeleteNode(Root);
621
 
  Root:=nil;
622
 
  FCount:=0;
623
 
end;
624
 
 
625
 
constructor TAvgLvlTree.Create(OnCompareMethod: TListSortCompare);
626
 
begin
627
 
  inherited Create;
628
 
  FOnCompare:=OnCompareMethod;
629
 
end;
630
 
 
631
 
constructor TAvgLvlTree.CreateObjectCompare(
632
 
  OnCompareMethod: TObjectSortCompare);
633
 
begin
634
 
  inherited Create;
635
 
  FOnObjectCompare:=OnCompareMethod;
636
 
end;
637
 
 
638
 
constructor TAvgLvlTree.Create;
639
 
begin
640
 
  Create(@ComparePointer);
641
 
end;
642
 
 
643
 
procedure TAvgLvlTree.Delete(ANode: TAvgLvlTreeNode);
644
 
var OldParent, OldLeft, OldRight, Successor, OldSuccParent, OldSuccLeft,
645
 
  OldSuccRight: TAvgLvlTreeNode;
646
 
  OldBalance: integer;
647
 
begin
648
 
  OldParent:=ANode.Parent;
649
 
  OldBalance:=ANode.Balance;
650
 
  ANode.Parent:=nil;
651
 
  ANode.Balance:=0;
652
 
  if ((ANode.Left=nil) and (ANode.Right=nil)) then begin
653
 
    // Node is Leaf (no children)
654
 
    if (OldParent<>nil) then begin
655
 
      // Node has parent
656
 
      if (OldParent.Left=ANode) then begin
657
 
        // Node is left Son of OldParent
658
 
        OldParent.Left:=nil;
659
 
        Inc(OldParent.Balance);
660
 
      end else begin
661
 
        // Node is right Son of OldParent
662
 
        OldParent.Right:=nil;
663
 
        Dec(OldParent.Balance);
664
 
      end;
665
 
      BalanceAfterDelete(OldParent);
666
 
    end else begin
667
 
      // Node is the only node of tree
668
 
      Root:=nil;
669
 
    end;
670
 
    dec(FCount);
671
 
    if NodeMemManager<>nil then
672
 
      NodeMemManager.DisposeNode(ANode)
673
 
    else
674
 
      ANode.Free;
675
 
    exit;
676
 
  end;
677
 
  if (ANode.Right=nil) then begin
678
 
    // Left is only son
679
 
    // and because DelNode is AVL, Right has no childrens
680
 
    // replace DelNode with Left
681
 
    OldLeft:=ANode.Left;
682
 
    ANode.Left:=nil;
683
 
    OldLeft.Parent:=OldParent;
684
 
    if (OldParent<>nil) then begin
685
 
      if (OldParent.Left=ANode) then begin
686
 
        OldParent.Left:=OldLeft;
687
 
        Inc(OldParent.Balance);
688
 
      end else begin
689
 
        OldParent.Right:=OldLeft;
690
 
        Dec(OldParent.Balance);
691
 
      end;
692
 
      BalanceAfterDelete(OldParent);
693
 
    end else begin
694
 
      Root:=OldLeft;
695
 
    end;
696
 
    dec(FCount);
697
 
    if NodeMemManager<>nil then
698
 
      NodeMemManager.DisposeNode(ANode)
699
 
    else
700
 
      ANode.Free;
701
 
    exit;
702
 
  end;
703
 
  if (ANode.Left=nil) then begin
704
 
    // Right is only son
705
 
    // and because DelNode is AVL, Left has no childrens
706
 
    // replace DelNode with Right
707
 
    OldRight:=ANode.Right;
708
 
    ANode.Right:=nil;
709
 
    OldRight.Parent:=OldParent;
710
 
    if (OldParent<>nil) then begin
711
 
      if (OldParent.Left=ANode) then begin
712
 
        OldParent.Left:=OldRight;
713
 
        Inc(OldParent.Balance);
714
 
      end else begin
715
 
        OldParent.Right:=OldRight;
716
 
        Dec(OldParent.Balance);
717
 
      end;
718
 
      BalanceAfterDelete(OldParent);
719
 
    end else begin
720
 
      Root:=OldRight;
721
 
    end;
722
 
    dec(FCount);
723
 
    if NodeMemManager<>nil then
724
 
      NodeMemManager.DisposeNode(ANode)
725
 
    else
726
 
      ANode.Free;
727
 
    exit;
728
 
  end;
729
 
  // DelNode has both: Left and Right
730
 
  // Replace ANode with symmetric Successor
731
 
  Successor:=FindSuccessor(ANode);
732
 
  OldLeft:=ANode.Left;
733
 
  OldRight:=ANode.Right;
734
 
  OldSuccParent:=Successor.Parent;
735
 
  OldSuccLeft:=Successor.Left;
736
 
  OldSuccRight:=Successor.Right;
737
 
  ANode.Balance:=Successor.Balance;
738
 
  Successor.Balance:=OldBalance;
739
 
  if (OldSuccParent<>ANode) then begin
740
 
    // at least one node between ANode and Successor
741
 
    ANode.Parent:=Successor.Parent;
742
 
    if (OldSuccParent.Left=Successor) then
743
 
      OldSuccParent.Left:=ANode
744
 
    else
745
 
      OldSuccParent.Right:=ANode;
746
 
    Successor.Right:=OldRight;
747
 
    OldRight.Parent:=Successor;
748
 
  end else begin
749
 
    // Successor is right son of ANode
750
 
    ANode.Parent:=Successor;
751
 
    Successor.Right:=ANode;
752
 
  end;
753
 
  Successor.Left:=OldLeft;
754
 
  if OldLeft<>nil then
755
 
    OldLeft.Parent:=Successor;
756
 
  Successor.Parent:=OldParent;
757
 
  ANode.Left:=OldSuccLeft;
758
 
  if ANode.Left<>nil then
759
 
    ANode.Left.Parent:=ANode;
760
 
  ANode.Right:=OldSuccRight;
761
 
  if ANode.Right<>nil then
762
 
    ANode.Right.Parent:=ANode;
763
 
  if (OldParent<>nil) then begin
764
 
    if (OldParent.Left=ANode) then
765
 
      OldParent.Left:=Successor
766
 
    else
767
 
      OldParent.Right:=Successor;
768
 
  end else
769
 
    Root:=Successor;
770
 
  // delete Node as usual
771
 
  Delete(ANode);
772
 
end;
773
 
 
774
 
procedure TAvgLvlTree.Remove(Data: Pointer);
775
 
var ANode: TAvgLvlTreeNode;
776
 
begin
777
 
  ANode:=Find(Data);
778
 
  if ANode<>nil then
779
 
    Delete(ANode);
780
 
end;
781
 
 
782
 
procedure TAvgLvlTree.RemovePointer(Data: Pointer);
783
 
var
784
 
  ANode: TAvgLvlTreeNode;
785
 
begin
786
 
  ANode:=FindPointer(Data);
787
 
  if ANode<>nil then
788
 
    Delete(ANode);
789
 
end;
790
 
 
791
 
destructor TAvgLvlTree.Destroy;
792
 
begin
793
 
  Clear;
794
 
  inherited Destroy;
795
 
end;
796
 
 
797
 
function TAvgLvlTree.Find(Data: Pointer): TAvgLvlTreeNode;
798
 
var Comp: integer;
799
 
begin
800
 
  Result:=Root;
801
 
  while (Result<>nil) do begin
802
 
    Comp:=Compare(Data,Result.Data);
803
 
    if Comp=0 then exit;
804
 
    if Comp<0 then begin
805
 
      Result:=Result.Left
806
 
    end else begin
807
 
      Result:=Result.Right
808
 
    end;
809
 
  end;
810
 
end;
811
 
 
812
 
function TAvgLvlTree.FindKey(Key: Pointer;
813
 
  OnCompareKeyWithData: TListSortCompare): TAvgLvlTreeNode;
814
 
var Comp: integer;
815
 
begin
816
 
  Result:=Root;
817
 
  while (Result<>nil) do begin
818
 
    Comp:=OnCompareKeyWithData(Key,Result.Data);
819
 
    if Comp=0 then exit;
820
 
    if Comp<0 then begin
821
 
      Result:=Result.Left
822
 
    end else begin
823
 
      Result:=Result.Right
824
 
    end;
825
 
  end;
826
 
end;
827
 
 
828
 
function TAvgLvlTree.FindNearestKey(Key: Pointer;
829
 
  OnCompareKeyWithData: TListSortCompare): TAvgLvlTreeNode;
830
 
var Comp: integer;
831
 
begin
832
 
  Result:=Root;
833
 
  while (Result<>nil) do begin
834
 
    Comp:=OnCompareKeyWithData(Key,Result.Data);
835
 
    if Comp=0 then exit;
836
 
    if Comp<0 then begin
837
 
      if Result.Left<>nil then
838
 
        Result:=Result.Left
839
 
      else
840
 
        exit;
841
 
    end else begin
842
 
      if Result.Right<>nil then
843
 
        Result:=Result.Right
844
 
      else
845
 
        exit;
846
 
    end;
847
 
  end;
848
 
end;
849
 
 
850
 
function TAvgLvlTree.FindLeftMostKey(Key: Pointer;
851
 
  OnCompareKeyWithData: TListSortCompare): TAvgLvlTreeNode;
852
 
begin
853
 
  Result:=FindLeftMostSameKey(FindKey(Key,OnCompareKeyWithData));
854
 
end;
855
 
 
856
 
function TAvgLvlTree.FindRightMostKey(Key: Pointer;
857
 
  OnCompareKeyWithData: TListSortCompare): TAvgLvlTreeNode;
858
 
begin
859
 
  Result:=FindRightMostSameKey(FindKey(Key,OnCompareKeyWithData));
860
 
end;
861
 
 
862
 
function TAvgLvlTree.FindLeftMostSameKey(ANode: TAvgLvlTreeNode): TAvgLvlTreeNode;
863
 
var
864
 
  LeftNode: TAvgLvlTreeNode;
865
 
  Data: Pointer;
866
 
begin
867
 
  if ANode<>nil then begin
868
 
    Data:=ANode.Data;
869
 
    Result:=ANode;
870
 
    repeat
871
 
      LeftNode:=FindPrecessor(Result);
872
 
      if (LeftNode=nil) or (Compare(Data,LeftNode.Data)<>0) then break;
873
 
      Result:=LeftNode;
874
 
    until false;
875
 
  end else begin
876
 
    Result:=nil;
877
 
  end;
878
 
end;
879
 
 
880
 
function TAvgLvlTree.FindRightMostSameKey(ANode: TAvgLvlTreeNode): TAvgLvlTreeNode;
881
 
var
882
 
  RightNode: TAvgLvlTreeNode;
883
 
  Data: Pointer;
884
 
begin
885
 
  if ANode<>nil then begin
886
 
    Data:=ANode.Data;
887
 
    Result:=ANode;
888
 
    repeat
889
 
      RightNode:=FindSuccessor(Result);
890
 
      if (RightNode=nil) or (Compare(Data,RightNode.Data)<>0) then break;
891
 
      Result:=RightNode;
892
 
    until false;
893
 
  end else begin
894
 
    Result:=nil;
895
 
  end;
896
 
end;
897
 
 
898
 
function TAvgLvlTree.FindNearest(Data: Pointer): TAvgLvlTreeNode;
899
 
var Comp: integer;
900
 
begin
901
 
  Result:=Root;
902
 
  while (Result<>nil) do begin
903
 
    Comp:=Compare(Data,Result.Data);
904
 
    if Comp=0 then exit;
905
 
    if Comp<0 then begin
906
 
      if Result.Left<>nil then
907
 
        Result:=Result.Left
908
 
      else
909
 
        exit;
910
 
    end else begin
911
 
      if Result.Right<>nil then
912
 
        Result:=Result.Right
913
 
      else
914
 
        exit;
915
 
    end;
916
 
  end;
917
 
end;
918
 
 
919
 
function TAvgLvlTree.FindPointer(Data: Pointer): TAvgLvlTreeNode;
920
 
// same as Find, but not comparing for key, but same Data too
921
 
begin
922
 
  Result:=FindLeftMost(Data);
923
 
  while (Result<>nil) do begin
924
 
    if Result.Data=Data then break;
925
 
    Result:=FindSuccessor(Result);
926
 
    if Compare(Data,Result.Data)<>0 then Result:=nil;
927
 
  end;
928
 
end;
929
 
 
930
 
function TAvgLvlTree.FindLeftMost(Data: Pointer): TAvgLvlTreeNode;
931
 
var
932
 
  Left: TAvgLvlTreeNode;
933
 
begin
934
 
  Result:=Find(Data);
935
 
  while (Result<>nil) do begin
936
 
    Left:=FindPrecessor(Result);
937
 
    if (Left=nil) or (Compare(Data,Left.Data)<>0) then break;
938
 
    Result:=Left;
939
 
  end;
940
 
end;
941
 
 
942
 
function TAvgLvlTree.FindRightMost(Data: Pointer): TAvgLvlTreeNode;
943
 
var
944
 
  Right: TAvgLvlTreeNode;
945
 
begin
946
 
  Result:=Find(Data);
947
 
  while (Result<>nil) do begin
948
 
    Right:=FindSuccessor(Result);
949
 
    if (Right=nil) or (Compare(Data,Right.Data)<>0) then break;
950
 
    Result:=Right;
951
 
  end;
952
 
end;
953
 
 
954
 
function TAvgLvlTree.FindInsertPos(Data: Pointer): TAvgLvlTreeNode;
955
 
var Comp: integer;
956
 
begin
957
 
  Result:=Root;
958
 
  while (Result<>nil) do begin
959
 
    Comp:=Compare(Data,Result.Data);
960
 
    if Comp<0 then begin
961
 
      if Result.Left<>nil then
962
 
        Result:=Result.Left
963
 
      else
964
 
        exit;
965
 
    end else begin
966
 
      if Result.Right<>nil then
967
 
        Result:=Result.Right
968
 
      else
969
 
        exit;
970
 
    end;
971
 
  end;
972
 
end;
973
 
 
974
 
function TAvgLvlTree.FindSuccessor(ANode: TAvgLvlTreeNode): TAvgLvlTreeNode;
975
 
begin
976
 
  Result:=ANode.Right;
977
 
  if Result<>nil then begin
978
 
    while (Result.Left<>nil) do Result:=Result.Left;
979
 
  end else begin
980
 
    Result:=ANode;
981
 
    while (Result.Parent<>nil) and (Result.Parent.Right=Result) do
982
 
      Result:=Result.Parent;
983
 
    Result:=Result.Parent;
984
 
  end;
985
 
end;
986
 
 
987
 
function TAvgLvlTree.FindPrecessor(ANode: TAvgLvlTreeNode): TAvgLvlTreeNode;
988
 
begin
989
 
  Result:=ANode.Left;
990
 
  if Result<>nil then begin
991
 
    while (Result.Right<>nil) do Result:=Result.Right;
992
 
  end else begin
993
 
    Result:=ANode;
994
 
    while (Result.Parent<>nil) and (Result.Parent.Left=Result) do
995
 
      Result:=Result.Parent;
996
 
    Result:=Result.Parent;
997
 
  end;
998
 
end;
999
 
 
1000
 
procedure TAvgLvlTree.MoveDataLeftMost(var ANode: TAvgLvlTreeNode);
1001
 
var LeftMost, PreNode: TAvgLvlTreeNode;
1002
 
  Data: Pointer;
1003
 
begin
1004
 
  if ANode=nil then exit;
1005
 
  LeftMost:=ANode;
1006
 
  repeat
1007
 
    PreNode:=FindPrecessor(LeftMost);
1008
 
    if (PreNode=nil) or (Compare(ANode,PreNode)<>0) then break;
1009
 
    LeftMost:=PreNode;
1010
 
  until false;
1011
 
  if LeftMost=ANode then exit;
1012
 
  Data:=LeftMost.Data;
1013
 
  LeftMost.Data:=ANode.Data;
1014
 
  ANode.Data:=Data;
1015
 
  ANode:=LeftMost;
1016
 
end;
1017
 
 
1018
 
procedure TAvgLvlTree.MoveDataRightMost(var ANode: TAvgLvlTreeNode);
1019
 
var RightMost, PostNode: TAvgLvlTreeNode;
1020
 
  Data: Pointer;
1021
 
begin
1022
 
  if ANode=nil then exit;
1023
 
  RightMost:=ANode;
1024
 
  repeat
1025
 
    PostNode:=FindSuccessor(RightMost);
1026
 
    if (PostNode=nil) or (Compare(ANode,PostNode)<>0) then break;
1027
 
    RightMost:=PostNode;
1028
 
  until false;
1029
 
  if RightMost=ANode then exit;
1030
 
  Data:=RightMost.Data;
1031
 
  RightMost.Data:=ANode.Data;
1032
 
  ANode.Data:=Data;
1033
 
  ANode:=RightMost;
1034
 
end;
1035
 
 
1036
 
function TAvgLvlTree.ConsistencyCheck: integer;
1037
 
var RealCount: integer;
1038
 
 
1039
 
  function CheckNode(ANode: TAvgLvlTreeNode): integer;
1040
 
  var LeftDepth, RightDepth: integer;
1041
 
  begin
1042
 
    if ANode=nil then begin
1043
 
      Result:=0;
1044
 
      exit;
1045
 
    end;
1046
 
    inc(RealCount);
1047
 
    // test left son
1048
 
    if ANode.Left<>nil then begin
1049
 
      if ANode.Left.Parent<>ANode then begin
1050
 
        Result:=-2;  exit;
1051
 
      end;
1052
 
      if Compare(ANode.Left.Data,ANode.Data)>0 then begin
1053
 
        Result:=-3;  exit;
1054
 
      end;
1055
 
      Result:=CheckNode(ANode.Left);
1056
 
      if Result<>0 then exit;
1057
 
    end;
1058
 
    // test right son
1059
 
    if ANode.Right<>nil then begin
1060
 
      if ANode.Right.Parent<>ANode then begin
1061
 
        Result:=-4;  exit;
1062
 
      end;
1063
 
      if Compare(ANode.Data,ANode.Right.Data)>0 then begin
1064
 
        Result:=-5;  exit;
1065
 
      end;
1066
 
      Result:=CheckNode(ANode.Right);
1067
 
      if Result<>0 then exit;
1068
 
    end;
1069
 
    // test balance
1070
 
    if ANode.Left<>nil then
1071
 
      LeftDepth:=ANode.Left.TreeDepth+1
1072
 
    else
1073
 
      LeftDepth:=0;
1074
 
    if ANode.Right<>nil then
1075
 
      RightDepth:=ANode.Right.TreeDepth+1
1076
 
    else
1077
 
      RightDepth:=0;
1078
 
    if ANode.Balance<>(RightDepth-LeftDepth) then begin
1079
 
      Result:=-6;  exit;
1080
 
    end;
1081
 
    // ok
1082
 
    Result:=0;
1083
 
  end;
1084
 
 
1085
 
// TAvgLvlTree.ConsistencyCheck
1086
 
begin
1087
 
  RealCount:=0;
1088
 
  Result:=CheckNode(Root);
1089
 
  if Result<>0 then exit;
1090
 
  if FCount<>RealCount then begin
1091
 
    Result:=-1;
1092
 
    exit;
1093
 
  end;
1094
 
end;
1095
 
 
1096
 
procedure TAvgLvlTree.FreeAndClear;
1097
 
 
1098
 
  procedure FreeNode(ANode: TAvgLvlTreeNode);
1099
 
  begin
1100
 
    if ANode=nil then exit;
1101
 
    FreeNode(ANode.Left);
1102
 
    FreeNode(ANode.Right);
1103
 
    if ANode.Data<>nil then TObject(ANode.Data).Free;
1104
 
    ANode.Data:=nil;
1105
 
  end;
1106
 
 
1107
 
// TAvgLvlTree.FreeAndClear
1108
 
begin
1109
 
  // free all data
1110
 
  FreeNode(Root);
1111
 
  // free all nodes
1112
 
  Clear;
1113
 
end;
1114
 
 
1115
 
procedure TAvgLvlTree.FreeAndDelete(ANode: TAvgLvlTreeNode);
1116
 
var OldData: TObject;
1117
 
begin
1118
 
  OldData:=TObject(ANode.Data);
1119
 
  Delete(ANode);
1120
 
  OldData.Free;
1121
 
end;
1122
 
 
1123
 
procedure TAvgLvlTree.WriteReportToStream(s: TStream;
1124
 
  var StreamSize: TStreamSeekType);
1125
 
var h: string;
1126
 
 
1127
 
  procedure WriteStr(const Txt: string);
1128
 
  begin
1129
 
    if s<>nil then
1130
 
      s.Write(Txt[1],length(Txt));
1131
 
    inc(StreamSize,length(Txt));
1132
 
  end;
1133
 
 
1134
 
  procedure WriteTreeNode(ANode: TAvgLvlTreeNode; const Prefix: string);
1135
 
  var b: string;
1136
 
  begin
1137
 
    if ANode=nil then exit;
1138
 
    WriteTreeNode(ANode.Right,Prefix+'  ');
1139
 
    b:=Prefix+Format('%p      Self=%p  Parent=%p  Balance=%d#13#10', [
1140
 
      ANode.Data, Pointer(ANode),Pointer(ANode.Parent), ANode.Balance]);
1141
 
    WriteStr(b);
1142
 
    WriteTreeNode(ANode.Left,Prefix+'  ');
1143
 
  end;
1144
 
 
1145
 
// TAvgLvlTree.WriteReportToStream
1146
 
begin
1147
 
  h:='Consistency: '+IntToStr(ConsistencyCheck)+' ---------------------'+#13#10;
1148
 
  WriteStr(h);
1149
 
  WriteTreeNode(Root,'  ');
1150
 
  h:='-End-Of-AVL-Tree---------------------'+#13#10;
1151
 
  WriteStr(h);
1152
 
end;
1153
 
 
1154
 
function TAvgLvlTree.ReportAsString: string;
1155
 
var ms: TMemoryStream;
1156
 
  StreamSize: TStreamSeekType;
1157
 
begin
1158
 
  Result:='';
1159
 
  ms:=TMemoryStream.Create;
1160
 
  try
1161
 
    StreamSize:=0;
1162
 
    WriteReportToStream(nil,StreamSize);
1163
 
    ms.Size:=StreamSize;
1164
 
    if StreamSize>0 then begin
1165
 
      StreamSize:=0;
1166
 
      WriteReportToStream(ms,StreamSize);
1167
 
      ms.Position:=0;
1168
 
      SetLength(Result,StreamSize);
1169
 
      ms.Read(Result[1],TMemStreamSeekType(StreamSize));
1170
 
    end;
1171
 
  finally
1172
 
    ms.Free;
1173
 
  end;
1174
 
end;
1175
 
 
1176
 
procedure TAvgLvlTree.SetOnCompare(const AValue: TListSortCompare);
1177
 
begin
1178
 
  if AValue=nil then
1179
 
    SetCompares(nil,FOnObjectCompare)
1180
 
  else
1181
 
    SetCompares(AValue,nil);
1182
 
end;
1183
 
 
1184
 
procedure TAvgLvlTree.SetOnObjectCompare(const AValue: TObjectSortCompare);
1185
 
begin
1186
 
  if AValue=nil then
1187
 
    SetCompares(FOnCompare,nil)
1188
 
  else
1189
 
    SetCompares(nil,AValue);
1190
 
end;
1191
 
 
1192
 
procedure TAvgLvlTree.SetCompares(const NewCompare: TListSortCompare;
1193
 
  const NewObjectCompare: TObjectSortCompare);
1194
 
var List: PPointer;
1195
 
  ANode: TAvgLvlTreeNode;
1196
 
  i, OldCount: integer;
1197
 
begin
1198
 
  if (FOnCompare=NewCompare) and (FOnObjectCompare=NewObjectCompare) then exit;
1199
 
  // sort the tree again
1200
 
  if Count>0 then begin
1201
 
    OldCount:=Count;
1202
 
    GetMem(List,SizeOf(Pointer)*OldCount);
1203
 
    try
1204
 
      // save the data in a list
1205
 
      ANode:=FindLowest;
1206
 
      i:=0;
1207
 
      while ANode<>nil do begin
1208
 
        List[i]:=ANode.Data;
1209
 
        inc(i);
1210
 
        ANode:=FindSuccessor(ANode);
1211
 
      end;
1212
 
      // clear the tree
1213
 
      Clear;
1214
 
      // set the new compare function
1215
 
      FOnCompare:=NewCompare;
1216
 
      FOnObjectCompare:=NewObjectCompare;
1217
 
      // re-add all nodes
1218
 
      for i:=0 to OldCount-1 do
1219
 
        Add(List[i]);
1220
 
    finally
1221
 
      FreeMem(List);
1222
 
    end;
1223
 
  end;
1224
 
end;
1225
 
 
1226
 
function TAvgLvlTree.Compare(Data1, Data2: Pointer): integer;
1227
 
begin
1228
 
  if Assigned(FOnCompare) then
1229
 
    Result:=FOnCompare(Data1,Data2)
1230
 
  else
1231
 
    Result:=FOnObjectCompare(Self,Data1,Data2);
1232
 
end;
1233
 
 
1234
 
 
1235
 
{ TAvgLvlTreeNode }
1236
 
 
1237
 
function TAvgLvlTreeNode.TreeDepth: integer;
1238
 
// longest WAY down. e.g. only one node => 0 !
1239
 
var LeftDepth, RightDepth: integer;
1240
 
begin
1241
 
  if Left<>nil then
1242
 
    LeftDepth:=Left.TreeDepth+1
1243
 
  else
1244
 
    LeftDepth:=0;
1245
 
  if Right<>nil then
1246
 
    RightDepth:=Right.TreeDepth+1
1247
 
  else
1248
 
    RightDepth:=0;
1249
 
  if LeftDepth>RightDepth then
1250
 
    Result:=LeftDepth
1251
 
  else
1252
 
    Result:=RightDepth;
1253
 
end;
1254
 
 
1255
 
procedure TAvgLvlTreeNode.Clear;
1256
 
begin
1257
 
  Parent:=nil;
1258
 
  Left:=nil;
1259
 
  Right:=nil;
1260
 
  Balance:=0;
1261
 
  Data:=nil;
1262
 
end;
1263
 
 
1264
 
{ TAvgLvlTreeNodeMemManager }
1265
 
 
1266
 
constructor TAvgLvlTreeNodeMemManager.Create;
1267
 
begin
1268
 
  inherited Create;
1269
 
  FFirstFree:=nil;
1270
 
  FFreeCount:=0;
1271
 
  FCount:=0;
1272
 
  FMinFree:=100;
1273
 
  FMaxFreeRatio:=8; // 1:1
1274
 
end;
1275
 
 
1276
 
destructor TAvgLvlTreeNodeMemManager.Destroy;
1277
 
begin
1278
 
  Clear;
1279
 
  inherited Destroy;
1280
 
end;
1281
 
 
1282
 
procedure TAvgLvlTreeNodeMemManager.DisposeNode(ANode: TAvgLvlTreeNode);
1283
 
begin
1284
 
  if ANode=nil then exit;
1285
 
  if (FFreeCount<FMinFree) or (FFreeCount<((FCount shr 3)*FMaxFreeRatio)) then
1286
 
  begin
1287
 
    // add ANode to Free list
1288
 
    ANode.Clear;
1289
 
    ANode.Right:=FFirstFree;
1290
 
    FFirstFree:=ANode;
1291
 
    inc(FFreeCount);
1292
 
    if (FFreeCount>(((8+FMaxFreeRatio)*FCount) shr 3)) then begin
1293
 
      DisposeFirstFreeNode;
1294
 
      DisposeFirstFreeNode;
1295
 
    end;
1296
 
  end else begin
1297
 
    // free list full -> free the ANode
1298
 
    ANode.Free;
1299
 
  end;
1300
 
  dec(FCount);
1301
 
end;
1302
 
 
1303
 
function TAvgLvlTreeNodeMemManager.NewNode: TAvgLvlTreeNode;
1304
 
begin
1305
 
  if FFirstFree<>nil then begin
1306
 
    // take from free list
1307
 
    Result:=FFirstFree;
1308
 
    FFirstFree:=FFirstFree.Right;
1309
 
    Result.Right:=nil;
1310
 
  end else begin
1311
 
    // free list empty -> create new node
1312
 
    Result:=TAvgLvlTreeNode.Create;
1313
 
  end;
1314
 
  inc(FCount);
1315
 
end;
1316
 
 
1317
 
procedure TAvgLvlTreeNodeMemManager.Clear;
1318
 
var ANode: TAvgLvlTreeNode;
1319
 
begin
1320
 
  while FFirstFree<>nil do begin
1321
 
    ANode:=FFirstFree;
1322
 
    FFirstFree:=FFirstFree.Right;
1323
 
    ANode.Right:=nil;
1324
 
    ANode.Free;
1325
 
  end;
1326
 
  FFreeCount:=0;
1327
 
end;
1328
 
 
1329
 
procedure TAvgLvlTreeNodeMemManager.SetMaxFreeRatio(NewValue: integer);
1330
 
begin
1331
 
  if NewValue<0 then NewValue:=0;
1332
 
  if NewValue=FMaxFreeRatio then exit;
1333
 
  FMaxFreeRatio:=NewValue;
1334
 
end;
1335
 
 
1336
 
procedure TAvgLvlTreeNodeMemManager.SetMinFree(NewValue: integer);
1337
 
begin
1338
 
  if NewValue<0 then NewValue:=0;
1339
 
  if NewValue=FMinFree then exit;
1340
 
  FMinFree:=NewValue;
1341
 
end;
1342
 
 
1343
 
procedure TAvgLvlTreeNodeMemManager.DisposeFirstFreeNode;
1344
 
var OldNode: TAvgLvlTreeNode;
1345
 
begin
1346
 
  if FFirstFree=nil then exit;
1347
 
  OldNode:=FFirstFree;
1348
 
  FFirstFree:=FFirstFree.Right;
1349
 
  dec(FFreeCount);
1350
 
  OldNode.Right:=nil;
1351
 
  OldNode.Free;
1352
 
end;
1353
 
 
1354
 
{ TStringToStringTree }
1355
 
 
1356
 
function TStringToStringTree.GetCount: Integer;
1357
 
begin
1358
 
  Result:=FItems.Count;
1359
 
end;
1360
 
 
1361
 
function TStringToStringTree.GetValues(const Name: string): string;
1362
 
var
1363
 
  Node: TAvgLvlTreeNode;
1364
 
begin
1365
 
  Node:=FindNode(Name);
1366
 
  if Node<>nil then
1367
 
    Result:=PStringToStringItem(Node.Data)^.Value
1368
 
  else
1369
 
    Result:='';
1370
 
end;
1371
 
 
1372
 
procedure TStringToStringTree.SetValues(const Name: string; const AValue: string
1373
 
  );
1374
 
var
1375
 
  NewItem: PStringToStringItem;
1376
 
  Node: TAvgLvlTreeNode;
1377
 
begin
1378
 
  Node:=FindNode(Name);
1379
 
  if (Node<>nil) then
1380
 
    PStringToStringItem(Node.Data)^.Value:=AValue
1381
 
  else begin
1382
 
    New(NewItem);
1383
 
    NewItem^.Name:=Name;
1384
 
    NewItem^.Value:=AValue;
1385
 
    FItems.Add(NewItem);
1386
 
  end;
1387
 
end;
1388
 
 
1389
 
function TStringToStringTree.FindNode(const Name: string): TAvgLvlTreeNode;
1390
 
begin
1391
 
   Result:=FItems.FindKey(@Name,FCompareNameWithItem);
1392
 
end;
1393
 
 
1394
 
function TStringToStringTree.GetNode(Node: TAvgLvlTreeNode;
1395
 
  out Name, Value: string): Boolean;
1396
 
var
1397
 
  Item: PStringToStringItem;
1398
 
begin
1399
 
  if Node<>nil then begin
1400
 
    Item:=PStringToStringItem(Node.Data);
1401
 
    Name:=Item^.Name;
1402
 
    Value:=Item^.Value;
1403
 
    Result:=true;
1404
 
  end else begin
1405
 
    Name:='';
1406
 
    Value:='';
1407
 
    Result:=false;
1408
 
  end;
1409
 
end;
1410
 
 
1411
 
constructor TStringToStringTree.Create(CaseSensitive: boolean);
1412
 
begin
1413
 
  if CaseSensitive then
1414
 
    Create(@CompareStringToStringItems,@ComparePAnsiStringWithStrToStrItem)
1415
 
  else
1416
 
    Create(@CompareStringToStringItemsI,@ComparePAnsiStringWithStrToStrItemI);
1417
 
end;
1418
 
 
1419
 
constructor TStringToStringTree.Create(const ACompareItems,
1420
 
  ACompareNameWithItem: TListSortCompare);
1421
 
begin
1422
 
  FCompareItems:=ACompareItems;
1423
 
  FCompareNameWithItem:=ACompareNameWithItem;
1424
 
  FItems:=TAvgLvlTree.Create(FCompareItems);
1425
 
end;
1426
 
 
1427
 
destructor TStringToStringTree.Destroy;
1428
 
begin
1429
 
  Clear;
1430
 
  FItems.Free;
1431
 
  inherited Destroy;
1432
 
end;
1433
 
 
1434
 
procedure TStringToStringTree.Clear;
1435
 
var
1436
 
  Node: TAvgLvlTreeNode;
1437
 
  Item: PStringToStringItem;
1438
 
begin
1439
 
  Node:=FItems.FindLowest;
1440
 
  while Node<>nil do begin
1441
 
    Item:=PStringToStringItem(Node.Data);
1442
 
    Dispose(Item);
1443
 
    Node:=FItems.FindSuccessor(Node);
1444
 
  end;
1445
 
  FItems.Clear;
1446
 
end;
1447
 
 
1448
 
procedure TStringToStringTree.Assign(Src: TStringToStringTree);
1449
 
var
1450
 
  Node: TAvgLvlTreeNode;
1451
 
  Item: PStringToStringItem;
1452
 
begin
1453
 
  Clear;
1454
 
  if Src=nil then exit;
1455
 
  Node:=Src.Tree.FindLowest;
1456
 
  while Node<>nil do begin
1457
 
    Item:=PStringToStringItem(Node.Data);
1458
 
    Values[Item^.Name]:=Item^.Value;
1459
 
    Node:=Src.Tree.FindSuccessor(Node);
1460
 
  end;
1461
 
end;
1462
 
 
1463
 
function TStringToStringTree.Contains(const Name: string): Boolean;
1464
 
begin
1465
 
  Result:=FindNode(Name)<>nil;
1466
 
end;
1467
 
 
1468
 
procedure TStringToStringTree.Delete(const Name: string);
1469
 
var
1470
 
  Node: TAvgLvlTreeNode;
1471
 
  Item: PStringToStringItem;
1472
 
begin
1473
 
  Node:=FindNode(Name);
1474
 
  if Node=nil then exit;
1475
 
  Item:=PStringToStringItem(Node.Data);
1476
 
  FItems.Delete(Node);
1477
 
  Dispose(Item);
1478
 
end;
1479
 
 
1480
 
procedure TStringToStringTree.Add(const Name, Value, Delimiter: string);
1481
 
var
1482
 
  OldValue: string;
1483
 
begin
1484
 
  OldValue:=Values[Name];
1485
 
  if OldValue<>'' then
1486
 
    OldValue:=OldValue+Delimiter;
1487
 
  OldValue:=OldValue+Value;
1488
 
  Values[Name]:=OldValue;
1489
 
end;
1490
 
 
1491
 
procedure TStringToStringTree.AddNameValues(List: TStrings);
1492
 
var
1493
 
  i: Integer;
1494
 
begin
1495
 
  for i:=0 to List.Count-1 do
1496
 
    Values[List.Names[i]]:=List.ValueFromIndex[i];
1497
 
end;
1498
 
 
1499
 
procedure TStringToStringTree.AddValues(List: TStrings);
1500
 
var
1501
 
  i: Integer;
1502
 
begin
1503
 
  for i:=0 to List.Count-1 do
1504
 
    Values[List[i]]:='';
1505
 
end;
1506
 
 
1507
 
function TStringToStringTree.GetFirst(out Name, Value: string): Boolean;
1508
 
begin
1509
 
  Result:=GetNode(Tree.FindLowest,Name,Value);
1510
 
end;
1511
 
 
1512
 
function TStringToStringTree.GetLast(out Name, Value: string): Boolean;
1513
 
begin
1514
 
  Result:=GetNode(Tree.FindHighest,Name,Value);
1515
 
end;
1516
 
 
1517
 
function TStringToStringTree.GetNext(const Name: string; out NextName,
1518
 
  NextValue: string): Boolean;
1519
 
var
1520
 
  Node: TAvgLvlTreeNode;
1521
 
begin
1522
 
  Node:=FindNode(Name);
1523
 
  if Node<>nil then
1524
 
    Node:=Tree.FindSuccessor(Node);
1525
 
  Result:=GetNode(Node,NextName,NextValue);
1526
 
end;
1527
 
 
1528
 
function TStringToStringTree.GetPrev(const Name: string; out PrevName,
1529
 
  PrevValue: string): Boolean;
1530
 
var
1531
 
  Node: TAvgLvlTreeNode;
1532
 
begin
1533
 
  Node:=FindNode(Name);
1534
 
  if Node<>nil then
1535
 
    Node:=Tree.FindPrecessor(Node);
1536
 
  Result:=GetNode(Node,PrevName,PrevValue);
1537
 
end;
1538
 
 
1539
 
 
1540
 
{ TPointerToPointerTree }
1541
 
 
1542
 
function TPointerToPointerTree.GetCount: Integer;
1543
 
begin
1544
 
  Result:=FItems.Count;
1545
 
end;
1546
 
 
1547
 
function TPointerToPointerTree.GetValues(const Key: Pointer): Pointer;
1548
 
var
1549
 
  Node: TAvgLvlTreeNode;
1550
 
begin
1551
 
  Node:=FindNode(Key);
1552
 
  if Node<>nil then
1553
 
    Result:=PPointerToPointerItem(Node.Data)^.Value
1554
 
  else
1555
 
    Result:=nil;
1556
 
end;
1557
 
 
1558
 
procedure TPointerToPointerTree.SetValues(const Key: Pointer;
1559
 
  const AValue: Pointer);
1560
 
var
1561
 
  NewItem: PPointerToPointerItem;
1562
 
  Node: TAvgLvlTreeNode;
1563
 
begin
1564
 
  Node:=FindNode(Key);
1565
 
  if (Node<>nil) then
1566
 
    PPointerToPointerItem(Node.Data)^.Value:=AValue
1567
 
  else begin
1568
 
    New(NewItem);
1569
 
    NewItem^.Key:=Key;
1570
 
    NewItem^.Value:=AValue;
1571
 
    FItems.Add(NewItem);
1572
 
  end;
1573
 
end;
1574
 
 
1575
 
function TPointerToPointerTree.FindNode(const Key: Pointer): TAvgLvlTreeNode;
1576
 
begin
1577
 
  Result:=FItems.FindKey(Key,@ComparePointerWithPtrToPtrItem)
1578
 
end;
1579
 
 
1580
 
function TPointerToPointerTree.GetNode(Node: TAvgLvlTreeNode; out Key,
1581
 
  Value: Pointer): Boolean;
1582
 
var
1583
 
  Item: PPointerToPointerItem;
1584
 
begin
1585
 
  if Node<>nil then begin
1586
 
    Item:=PPointerToPointerItem(Node.Data);
1587
 
    Key:=Item^.Key;
1588
 
    Value:=Item^.Value;
1589
 
    Result:=true;
1590
 
  end else begin
1591
 
    Key:=nil;
1592
 
    Value:=nil;
1593
 
    Result:=false;
1594
 
  end;
1595
 
end;
1596
 
 
1597
 
constructor TPointerToPointerTree.Create;
1598
 
begin
1599
 
  FItems:=TAvgLvlTree.Create(@ComparePointerToPointerItems);
1600
 
end;
1601
 
 
1602
 
destructor TPointerToPointerTree.Destroy;
1603
 
begin
1604
 
  Clear;
1605
 
  FItems.Free;
1606
 
  inherited Destroy;
1607
 
end;
1608
 
 
1609
 
procedure TPointerToPointerTree.Clear;
1610
 
var
1611
 
  Node: TAvgLvlTreeNode;
1612
 
  Item: PPointerToPointerItem;
1613
 
begin
1614
 
  Node:=FItems.FindLowest;
1615
 
  while Node<>nil do begin
1616
 
    Item:=PPointerToPointerItem(Node.Data);
1617
 
    Dispose(Item);
1618
 
    Node:=FItems.FindSuccessor(Node);
1619
 
  end;
1620
 
  FItems.Clear;
1621
 
end;
1622
 
 
1623
 
procedure TPointerToPointerTree.Remove(Key: Pointer);
1624
 
var
1625
 
  Node: TAvgLvlTreeNode;
1626
 
  Item: PPointerToPointerItem;
1627
 
begin
1628
 
  Node:=FindNode(Key);
1629
 
  if Node=nil then exit;
1630
 
  Item:=PPointerToPointerItem(Node.Data);
1631
 
  FItems.Delete(Node);
1632
 
  Dispose(Item);
1633
 
end;
1634
 
 
1635
 
function TPointerToPointerTree.Contains(const Key: Pointer): Boolean;
1636
 
begin
1637
 
  Result:=FindNode(Key)<>nil;
1638
 
end;
1639
 
 
1640
 
function TPointerToPointerTree.GetFirst(out Key, Value: Pointer): Boolean;
1641
 
begin
1642
 
  Result:=GetNode(Tree.FindLowest,Key,Value);
1643
 
end;
1644
 
 
1645
 
function TPointerToPointerTree.GetLast(out Key, Value: Pointer): Boolean;
1646
 
begin
1647
 
  Result:=GetNode(Tree.FindHighest,Key,Value);
1648
 
end;
1649
 
 
1650
 
function TPointerToPointerTree.GetNext(const Key: Pointer; out NextKey,
1651
 
  NextValue: Pointer): Boolean;
1652
 
var
1653
 
  Node: TAvgLvlTreeNode;
1654
 
begin
1655
 
  Node:=FindNode(Key);
1656
 
  if Node<>nil then
1657
 
    Node:=Tree.FindSuccessor(Node);
1658
 
  Result:=GetNode(Node,NextKey,NextValue);
1659
 
end;
1660
 
 
1661
 
function TPointerToPointerTree.GetPrev(const Key: Pointer; out PrevKey,
1662
 
  PrevValue: Pointer): Boolean;
1663
 
var
1664
 
  Node: TAvgLvlTreeNode;
1665
 
begin
1666
 
  Node:=FindNode(Key);
1667
 
  if Node<>nil then
1668
 
    Node:=Tree.FindPrecessor(Node);
1669
 
  Result:=GetNode(Node,PrevKey,PrevValue);
1670
 
end;
1671
 
 
1672
 
end.