Merged: avltree branch

Test/Forms/FBTree.dfm

@@ -0,0 +1,33 @@
+object frmBTree: TfrmBTree
+  Left = 199
+  Top = 107
+  Width = 603
+  Height = 410
+  Caption = 'Binary Tree Debug'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  OldCreateOrder = False
+  PixelsPerInch = 96
+  TextHeight = 13
+  object ocTree: TdxOrgChart
+    Left = 0
+    Top = 0
+    Width = 595
+    Height = 383
+    DefaultNodeWidth = 50
+    BorderStyle = bsNone
+    Options = [ocSelect, ocRect3D]
+    Align = alClient
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clWindowText
+    Font.Height = -11
+    Font.Name = 'MS Sans Serif'
+    Font.Style = []
+    ParentColor = True
+    OnDblClick = ocTreeDblClick
+  end
+end

Test/Forms/FBTree.pas

@@ -0,0 +1,129 @@
+unit FBTree;
+
+interface
+uses
+  Forms,
+  Classes,
+  Controls,
+  Windows,
+  dxorgchr,
+  X2UtBinaryTree;
+
+type
+  TfrmBTree = class(TForm)
+    ocTree:           TdxOrgChart;
+    procedure ocTreeDblClick(Sender: TObject);
+  private
+    FTree:            TX2UtCustomBTree;
+  protected
+    procedure BuildTree(const ARoot: PX2UtBTreeNode;
+                        const AParent: TdxOcNode = nil);
+  public
+    class procedure Execute(const ATree: TX2UtCustomBTree;
+                            const AShowModal: Boolean = True);
+  end;
+
+implementation
+uses
+  Graphics,
+  SysUtils,
+  TypInfo;
+
+type
+  THackBTree  = class(TX2UtCustomBTree);
+
+
+{$R *.dfm}
+
+class procedure TfrmBTree.Execute;
+begin
+  with TfrmBTree.Create(nil) do
+  try
+    FTree := ATree;
+    BuildTree(THackBTree(ATree).Root);
+
+    if Assigned(ocTree.RootNode) then
+      ocTree.RootNode.Expand(True);
+
+    if AShowModal then
+      ShowModal()
+    else
+      Show();
+  finally
+    // Yes, yes, memory leak I know. Should have an owner of something. Anyways,
+    // I'm too lazy to fix it in this test application...
+    if AShowModal then
+      Free();
+  end;
+end;
+
+procedure TfrmBTree.BuildTree;
+  function CreateTextNode(const AParent: TdxOcNode;
+                          const AText: String): TdxOcNode;
+  begin
+    Result        := ocTree.AddChild(AParent, nil);
+    Result.Text   := AText;
+    Result.Color  := clInfoBk;
+  end;
+
+  function CreateNode(const AParent: TdxOcNode;
+                      const ANode: PX2UtBTreeNode): TdxOcNode;
+  begin
+    Result      := CreateTextNode(AParent, IntToStr(ANode^.Index) + #13#10 +
+                                  IntToStr(ANode^.Balance));
+    Result.Data := ANode;
+  end;
+
+var
+  pNode:        TdxOcNode;
+  pLeft:        TdxOcNode;
+  pRight:       TdxOcNode;
+
+begin
+  if not Assigned(ARoot) then
+    exit;
+    
+  pLeft   := nil;
+  pRight  := nil;
+  
+  if not Assigned(AParent) then
+    pNode       := CreateNode(nil, ARoot)
+  else
+    pNode       := AParent;
+
+  if Assigned(ARoot^.Children[0]) then
+    pLeft       := CreateNode(pNode, ARoot^.Children[0])
+  else if Assigned(ARoot^.Children[1]) then
+    CreateTextNode(pNode, '<nil>');
+
+  if Assigned(ARoot^.Children[1]) then
+    pRight      := CreateNode(pNode, ARoot^.Children[1])
+  else if Assigned(ARoot^.Children[0]) then
+    CreateTextNode(pNode, '<nil>');
+
+  if Assigned(ARoot^.Children[0]) then
+    BuildTree(ARoot^.Children[0], pLeft);
+
+  if Assigned(ARoot^.Children[1]) then
+    BuildTree(ARoot^.Children[1], pRight);
+end;
+
+procedure TfrmBTree.ocTreeDblClick;
+var
+  pNode:      TdxOcNode;
+
+begin
+  pNode := ocTree.Selected;
+
+  if Assigned(pNode) and Assigned(pNode.Data) then
+  begin
+    FTree.Delete(PX2UtBTreeNode(pNode.Data)^.Index);
+    ocTree.Clear();
+
+    BuildTree(THackBTree(FTree).Root);
+    if Assigned(ocTree.RootNode) then
+      ocTree.RootNode.Expand(True);
+  end;
+end;
+
+end.

Test/X2UtHashesTest.cfg

@@ -32,6 +32,6 @@
 -M
 -$M16384,1048576
 -K$00400000
--LE"c:\program files\borland\delphi6\Projects\Bpl"
+-LE"c:\delphi6\Projects\Bpl"
--LN"c:\program files\borland\delphi6\Projects\Bpl"
+-LN"c:\delphi6\Projects\Bpl"
 -DmadExcept

Test/X2UtHashesTest.dof

@@ -46,7 +46,7 @@ UnitOutputDir=
 PackageDLLOutputDir=
 PackageDCPOutputDir=
 SearchPath=
-Packages=vcl;rtl;dbrtl;vcldb;vclx;dss;dsnapcrba;dsnapcon;inetdb;webdsnap;websnap;dbxcds;Irc;parsdpk;hotspotter
+Packages=vcl;rtl;dbrtl;vcldb;vclx;dss;dsnapcrba;dsnapcon;inetdb;webdsnap;websnap;dbxcds;Irc;parsdpk;hotspotter;dxorgcD6
 Conditionals=madExcept
 DebugSourceDirs=
 UsePackages=0
@@ -56,6 +56,10 @@ HostApplication=
 Launcher=
 UseLauncher=0
 DebugCWD=
+[Language]
+ActiveLang=
+ProjectLang=
+RootDir=
 [Version Info]
 IncludeVerInfo=0
 AutoIncBuild=0
@@ -184,16 +188,7 @@ c:\program files\borland\delphi6\Bin\dclwebsnap60.bpl=Borland WebSnap Components
 c:\program files\borland\delphi6\Bin\dclite60.bpl=Borland Integrated Translation Environment
 c:\program files\borland\delphi6\Bin\dcldbx60.bpl=Borland dbExpress Components
 c:\program files\borland\delphi6\Bin\dcldbxcds60.bpl=Borland Local DBX ClientDataset Components
-[Included Packages]
+<<<<<<< .working
-C:\Program Files\Borland\Delphi6\Bin\dclstd60.bpl=Borland Standard Components
+=======
-c:\program files\borland\delphi6\Bin\dclsmpedit60.bpl=Borland Editor Script Enhancements
+F:\Delphi\Components\DevExpress\OrgChart Suite\Lib\dcldxDBOrD6.bpl=ExpressDBOrgChart by Developer Express Inc.
-C:\Program Files\Borland\Delphi6\Bin\dcldb60.bpl=Borland Database Components
+>>>>>>> .merge-right.r40
-C:\Program Files\Borland\Delphi6\Bin\dclact60.bpl=Borland ActionBar Components
-F:\Delphi\Components\madCollection\madBasic\Delphi 6\madBasic_.bpl=madBasic 1.1f  ·  www.madshi.net
-F:\Delphi\Components\madCollection\madDisAsm\Delphi 6\madDisAsm_.bpl=madDisAsm 2.0a  ·  www.madshi.net
-F:\Delphi\Components\madCollection\madExcept\Delphi 6\madExcept_.bpl=madExcept 2.6a  ·  www.madshi.net
-F:\Delphi\Components\madCollection\madExcept\Delphi 6\madExceptWizard_.bpl=madExceptWizard 2.6  ·  www.madshi.net
-c:\program files\borland\delphi6\Bin\dclcds60.bpl=Borland Base Cached ClientDataset Component
-C:\Program Files\Borland\Delphi6\Bin\dclmid60.bpl=Borland MyBase DataAccess Components
-C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\ThemeManager6.bpl=Windows XP Theme Manager
-H:\Downloads\commentexpert.bpl=Comment Expert v1.0 Alpha

Test/X2UtHashesTest.dpr

@@ -7,9 +7,11 @@ uses
   madLinkDisAsm,
   SysUtils,
   X2UtHashes,
-  X2UtBinaryTree;
+  X2UtBinaryTree,
+  FBTree in 'Forms\FBTree.pas' {frmBTree};
 
 
+<<<<<<< .working
 procedure DebugBTree(const ANode: PX2UtBTreeNode; const AIndent: Integer = 0);
 begin
   WriteLn(StringOfChar(' ', AIndent), ANode^.Index);
@@ -25,6 +27,8 @@ end;
 type
   THackBTree  = class(TX2UtCustomBTree);
 
+=======
+>>>>>>> .merge-right.r40
 var
   shData:       TX2UtStringHash;
   btTest:       TX2UtStringBTree;
@@ -37,25 +41,32 @@ begin
   btTest  := TX2UtStringBTree.Create();
   try
     Randomize();
-    for iItem := 0 to 31 do
+    for iItem := 0 to 61 do
       btTest[Random(500)] := 'bla';
 
+<<<<<<< .working
     btTest[300] := 'bla';
     btTest.Delete(300);
+=======
+    TfrmBTree.Execute(btTest);
+>>>>>>> .merge-right.r40
 
+<<<<<<< .working
     // Heh, hacking my own class. This is just for debugging the tree,
     // there should never be any need to access the root node outside of the
     // class otherwise, so I made it protected.
     pItem := THackBTree(btTest).Root;
     DebugBTree(pItem);
 
+=======
+>>>>>>> .merge-right.r40
     WriteLn;
     btTest.Reset();
     while btTest.Next() do
       WriteLn(btTest.CurrentIndex, ' - ', btTest.CurrentValue);
   finally
     FreeAndNil(btTest);
-    ReadLn;
+    //ReadLn;
   end;
   }
 
@@ -64,12 +75,16 @@ begin
     shData['thisakslhalskdjfhaslkdfjhaslkfjh']  := 'is';
     shData['a']     := 'test';
 
+    TfrmBTree.Execute(shData);
+
+    {
     shData.Reset();
     while shData.Next() do
       WriteLn(shData.CurrentKey, ': ', shData.CurrentValue, ' (',
               shData[shData.CurrentKey], ')');
+      }
   finally
     FreeAndNil(shData);
-    ReadLn;
+    //ReadLn;
   end;
 end.

Test/X2UtilsSettingsTest.dpr

@@ -97,10 +97,8 @@ begin
     }
 
     // Test for the definitions
-    {
     Settings.Define('Test', 'Value', 5, [[0, 5], [10, 15]]);
     Settings.ReadInteger('Test', 'Value');
-    }
 
     TraverseSection(Settings, '', 1);
     WriteLn;

X2UtBinaryTree.pas

@@ -9,6 +9,9 @@
   :: convenience reasons I will however ignore your ranting and call my
   :: classes "TX2UtBTree". ;)
   ::
+  :: This unit contains code based on GNU libavl:
+  ::    http://www.msu.edu/~pfaffben/avl/libavl.html/
+  ::
   :: Last changed:    $Date$
   :: Revision:        $Rev$
   :: Author:          $Author$
@@ -17,8 +20,7 @@ unit X2UtBinaryTree;
 
 interface
 uses
-  SysUtils,
+  SysUtils;
-  VirtualTrees;
 
 type
   //:$ Raised when the cursor is invalid.
@@ -28,31 +30,48 @@ type
   {
     :$ Internal representation of a node.
   }
+  PPX2UtBTreeNode   = ^PX2UtBTreeNode;
   PX2UtBTreeNode    = ^TX2UtBTreeNode;
   TX2UtBTreeNode    = record
     Index:      Cardinal;
-    Parent:     PX2UtBTreeNode;
+    Children:   array[0..1] of PX2UtBTreeNode;
-    Left:       PX2UtBTreeNode;
+    Balance:    Integer;
-    Right:      PX2UtBTreeNode;
     Data:       record end;
   end;
 
   {
-    :$ Internal parent stack
+    :$ Internal node stack
   }
+  TX2UtBTreeStackItem = record
+    Node:           PX2UtBTreeNode;
+    Direction:      Integer;
+  end;
+
   TX2UtBTreeStack     = class(TObject)
   private
-    FItems:         array of PX2UtBTreeNode;
+    FItems:         array of TX2UtBTreeStackItem;
     FCount:         Integer;
     FPosition:      Integer;
+
+    function GetCount(): Integer;
+    function GetNode(Index: Integer): PX2UtBTreeNode;
+    function GetDirection(Index: Integer): Integer;
+    procedure SetDirection(Index: Integer; const Value: Integer);
+    procedure SetNode(Index: Integer; const Value: PX2UtBTreeNode);
   public
     constructor Create();
 
     procedure Clear();
-    procedure Push(const ANode: PX2UtBTreeNode);
+    procedure Push(const ANode: PX2UtBTreeNode; const ADirection: Integer = 0);
-    function Pop(): PX2UtBTreeNode;
+    function Pop(): PX2UtBTreeNode; overload;
+    function Pop(var ADirection: Integer): PX2UtBTreeNode; overload;
 
-    procedure Reverse();
+    property Node[Index: Integer]:        PX2UtBTreeNode  read GetNode
+                                                          write SetNode; default;
+    property Direction[Index: Integer]:   Integer         read GetDirection
+                                                          write SetDirection;
+
+    property Count:     Integer read GetCount;
   end;
 
   {
@@ -63,10 +82,11 @@ type
   }
   TX2UtCustomBTree  = class(TObject)
   private
+    FCount:         Integer;
     FRoot:          PX2UtBTreeNode;
     FCursor:        PX2UtBTreeNode;
     FIsReset:       Boolean;
-    FParent:        TX2UtBTreeStack;
+    FParents:       TX2UtBTreeStack;
 
     FNodeSize:      Cardinal;
     FDataSize:      Cardinal;
@@ -74,12 +94,31 @@ type
     function GetTotalSize(): Cardinal;
   protected
     function GetCurrentIndex(): Cardinal;
-
     function GetNodeData(const ANode: PX2UtBTreeNode): Pointer; virtual;
+    procedure CopyNodeData(const ASource, ADest: PX2UtBTreeNode);
+
+    procedure BalanceInsert(var ANode: PX2UtBTreeNode);
+
     function LookupNode(const AIndex: Cardinal;
                         const ACanCreate: Boolean = False;
                         const ASetCursor: Boolean = False): PX2UtBTreeNode;
 
+    procedure RotateLeft(var ANode: PX2UtBTreeNode);
+    procedure RotateRight(var ANode: PX2UtBTreeNode);
+
+    function DeleteLeftShrunk(var ANode: PX2UtBTreeNode): Integer;
+    function DeleteRightShrunk(var ANode: PX2UtBTreeNode): Integer;
+    function DeleteFindHighest(const ATarget: PX2UtBTreeNode;
+                               var ANode: PX2UtBTreeNode;
+                               out AResult: Integer): Boolean;
+    function DeleteFindLowest(const ATarget: PX2UtBTreeNode;
+                              var ANode: PX2UtBTreeNode;
+                              out AResult: Integer): Boolean;
+
+    function InternalDeleteNode(var ARoot: PX2UtBTreeNode;
+                                const AIndex: Cardinal): Integer;
+    procedure DeleteNode(const AIndex: Cardinal);
+
     procedure InitNode(var ANode: PX2UtBTreeNode); virtual;
     procedure FreeNode(var ANode: PX2UtBTreeNode); virtual;
 
@@ -89,7 +128,7 @@ type
     property Cursor:          PX2UtBTreeNode  read FCursor    write FCursor;
     property Root:            PX2UtBTreeNode  read FRoot;
     property IsReset:         Boolean         read FIsReset   write FIsReset;
-    property Parent:          TX2UtBTreeStack read FParent;
+    property Parents:         TX2UtBTreeStack read FParents;
 
     property NodeSize:        Cardinal        read FNodeSize;
     property TotalSize:       Cardinal        read GetTotalSize;
@@ -128,6 +167,9 @@ type
     //:! The order in which nodes are traversed is from top to bottom, left
     //:! to right. Do not depend on the binary tree to sort the output.
     function Next(): Boolean; virtual;
+
+    //:$ Contains the number of nodes in the tree
+    property Count:       Integer   read FCount;
   end;
 
   {
@@ -203,6 +245,12 @@ resourcestring
 
 const
   CStackSize      = 32;
+  CLeft           = 0;
+  CRight          = 1;
+
+  CError          = 0;
+  COK             = 1;
+  CBalance        = 2;
 
 
 {======================== TX2UtBTreeStack
@@ -234,39 +282,64 @@ begin
     SetLength(FItems, FCount);
   end;
 
-  FItems[FPosition] := ANode;
+  with FItems[FPosition] do
+  begin
+    Node      := ANode;
+    Direction := ADirection;
+  end;
 end;
 
-function TX2UtBTreeStack.Pop;
+function TX2UtBTreeStack.Pop(): PX2UtBTreeNode;
 begin
   Result  := nil;
-  if FPosition > -1 then
+  if FPosition >= 0 then
   begin
-    Result  := FItems[FPosition];
+    Result      := FItems[FPosition].Node;
     Dec(FPosition);
   end;
 end;
 
-
+function TX2UtBTreeStack.Pop(var ADirection: Integer): PX2UtBTreeNode;
-procedure TX2UtBTreeStack.Reverse;
-var
-  iCount:       Integer;
-  iIndex:       Integer;
-  pSwap:        PX2UtBTreeNode;
-
 begin
-  if FPosition = -1 then
+  Result  := nil;
-    exit;
+  if FPosition >= 0 then
-
-  iCount  := (FPosition + 1) div 2;
-  for iIndex  := 0 to iCount - 1 do
   begin
-    pSwap                       := FItems[iIndex];
+    ADirection  := FItems[FPosition].Direction;
-    FItems[iIndex]              := FItems[FPosition - iIndex];
+    Result      := FItems[FPosition].Node;
-    FItems[FPosition - iIndex]  := pSwap;
+    Dec(FPosition);
   end;
 end;
 
+function TX2UtBTreeStack.GetNode;
+begin
+  Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!');
+  Result  := FItems[Index].Node;
+end;
+
+procedure TX2UtBTreeStack.SetNode;
+begin
+  Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!');
+  FItems[Index].Node  := Value;
+end;
+
+function TX2UtBTreeStack.GetDirection;
+begin
+  Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!');
+  Result  := FItems[Index].Direction;
+end;
+
+procedure TX2UtBTreeStack.SetDirection;
+begin
+  Assert((Index >= 0) and (Index <= FPosition), '* BUG * Invalid stack index!');
+  FItems[Index].Direction := Value;
+end;
+
+
+function TX2UtBTreeStack.GetCount;
+begin
+  Result  := FPosition + 1;
+end;
+
 
 {======================= TX2UtCustomBTree
   Initialization
@@ -275,16 +348,14 @@ constructor TX2UtCustomBTree.Create;
 begin
   inherited;
 
-  FParent   := TX2UtBTreeStack.Create();
+  FParents  := TX2UtBTreeStack.Create();
   FNodeSize := SizeOf(TX2UtBTreeNode);
 end;
 
 destructor TX2UtCustomBTree.Destroy;
 begin
-  FreeAndNil(FParent);
+  FreeAndNil(FParents);
-
+  Clear();
-  if Assigned(FRoot) then
-    FreeNode(FRoot);
 
   inherited;
 end;
@@ -299,87 +370,463 @@ begin
   Result  := Pointer(Cardinal(ANode) + NodeSize);
 end;
 
-function TX2UtCustomBTree.LookupNode;
+procedure TX2UtCustomBTree.CopyNodeData;
+begin
+  ADest^.Index  := ASource^.Index;
+  Move(GetNodeData(ASource)^,
+       GetNodeData(ADest)^,
+       DataSize);
+end;
+
+
+procedure TX2UtCustomBTree.BalanceInsert;
 var
   pNode:        PX2UtBTreeNode;
+  pSwap:        PX2UtBTreeNode;
+
+begin
+  if ANode^.Balance = -2 then
+  begin
+    // Left-heavy
+    pNode := ANode^.Children[CLeft];
+
+    if pNode^.Balance = -1 then
+    begin
+      pSwap                     := pNode;
+      ANode^.Children[CLeft]    := pNode^.Children[CRight];
+      pNode^.Children[CRight]   := ANode;
+      pNode^.Balance            := 0;
+      ANode^.Balance            := 0;
+    end else
+    begin
+      Assert(pNode^.Balance = 1, '* BUG * Unexpected node balance');
+      pSwap                     := pNode^.Children[CRight];
+      pNode^.Children[CRight]   := pSwap^.Children[CLeft];
+      pSwap^.Children[CLeft]    := pNode;
+      ANode^.Children[CLeft]    := pSwap^.Children[CRight];
+      pSwap^.Children[CRight]   := ANode;
+
+      case pSwap^.Balance of
+        -1:
+          begin
+            pNode^.Balance      := 0;
+            ANode^.Balance      := 1;
+          end;
+        0:
+          begin
+            pNode^.Balance      := 0;
+            ANode^.Balance      := 0;
+          end;
+      else
+        pNode^.Balance          := -1;
+        ANode^.Balance          := 0;
+      end;
+
+      pSwap^.Balance            := 0;
+    end;
+
+    ANode := pSwap;
+  end else if ANode^.Balance = 2 then
+  begin
+    // Right-heavy
+    pNode := ANode^.Children[CRight];
+
+    if pNode^.Balance = 1 then
+    begin
+      pSwap                     := pNode;
+      ANode^.Children[CRight]   := pNode^.Children[CLeft];
+      pNode^.Children[CLeft]    := ANode;
+      pNode^.Balance            := 0;
+      ANode^.Balance            := 0;
+    end else
+    begin
+      Assert(pNode^.Balance = -1, '* BUG * Unexpected node balance');
+      pSwap                     := pNode^.Children[CLeft];
+      pNode^.Children[CLeft]    := pSwap^.Children[CRight];
+      pSwap^.Children[CRight]   := pNode;
+      ANode^.Children[CRight]   := pSwap^.Children[CLeft];
+      pSwap^.Children[CLeft]    := ANode;
+
+      case pSwap^.Balance of
+        1:
+          begin
+            pNode^.Balance      := 0;
+            ANode^.Balance      := -1;
+          end;
+        0:
+          begin
+            pNode^.Balance      := 0;
+            ANode^.Balance      := 0;
+          end;
+      else
+        pNode^.Balance          := 1;
+        ANode^.Balance          := 0;
+      end;
+
+      pSwap^.Balance  := 0;
+    end;
+
+    ANode := pSwap;
+  end;
+end;
+
+
+function TX2UtCustomBTree.LookupNode;
+var
+  pCurrent:         PPX2UtBTreeNode;
+  pBalance:         PPX2UtBTreeNode;
+  pLast:            PX2UtBTreeNode;
+  pNode:            PX2UtBTreeNode;
+  pPath:            TX2UtBTreeStack;
 
 begin
   Result    := nil;
 
-  if not Assigned(FRoot) then
-  begin
-    if ACanCreate then
-    begin
-      InitNode(FRoot);
-      FRoot^.Index  := AIndex;
-      Result        := FRoot;
-
   if ASetCursor then
+    Parents.Clear();
+
+  pPath     := TX2UtBTreeStack.Create();
+  try
+    pCurrent  := @FRoot;
+    pBalance  := nil;
+
+    repeat
+      if Assigned(pCurrent^) then
       begin
-        Parent.Clear();
+        pPath.Push(pCurrent^);
-        Cursor  := FRoot;
+        if pCurrent^^.Balance <> 0 then
+          pBalance  := pCurrent;
+
+        if AIndex > pCurrent^^.Index then
+          // Continue on the right side
+          pCurrent  := @pCurrent^^.Children[CRight]
+        else if AIndex < pCurrent^^.Index then
+          // Continue on the left side
+          pCurrent  := @pCurrent^^.Children[CLeft]
+        else
+        begin
+          // Found it!
+          Result    := pCurrent^;
+          break;
+        end;
+      end else if ACanCreate then
+      begin
+        // Create new node
+        InitNode(pCurrent^);
+        pCurrent^^.Index  := AIndex;
+
+        // Update balance factors
+        pLast := pCurrent^;
+        pNode := pPath.Pop();
+
+        while Assigned(pNode) do
+        begin
+          if pNode^.Children[CLeft] = pLast then
+            Dec(pNode^.Balance)
+          else
+            Inc(pNode^.Balance);
+
+          if Assigned(pBalance) and (pNode = pBalance^) then
+            break;
+
+          pLast := pNode;
+          pNode := pPath.Pop();
+        end;
+
+        if Assigned(pBalance) then
+          BalanceInsert(pBalance^);
+
+        break;
+      end else
+        break;
+    until False;
+  finally
+    FreeAndNil(pPath);
+  end;
+end;
+
+
+procedure TX2UtCustomBTree.RotateLeft;
+var
+  pSwap:        PX2UtBTreeNode;
+
+begin
+  pSwap                   := ANode;
+  ANode                   := ANode^.Children[CRight];
+  pSwap^.Children[CRight] := ANode^.Children[CLeft];
+  ANode^.Children[CLeft]  := pSwap;
+end;
+
+procedure TX2UtCustomBTree.RotateRight;
+var
+  pSwap:        PX2UtBTreeNode;
+
+begin
+  pSwap                   := ANode;
+  ANode                   := ANode^.Children[CLeft];
+  pSwap^.Children[CLeft]  := ANode^.Children[CRight];
+  ANode^.Children[CRight] := pSwap;
+end;
+
+
+function TX2UtCustomBTree.DeleteLeftShrunk;
+begin
+  case ANode^.Balance of
+    -1:
+      begin
+        ANode^.Balance  := 0;
+        Result          := CBalance;
+      end;
+    0:
+      begin
+        ANode^.Balance  := 1;
+        Result          := COK;
+      end;
+    1:
+      begin
+        case ANode^.Children[CRight]^.Balance of
+          1:
+            begin
+              if ANode^.Children[CRight]^.Balance = 0 then
+                ANode^.Balance  := 1
+              else
+                ANode^.Balance  := 0;
+
+              RotateLeft(ANode);
+              Result  := CBalance;
+            end;
+          0:
+            begin
+              ANode^.Balance                    := 1;
+              ANode^.Children[CRight]^.Balance  := -1;
+              RotateLeft(ANode);
+              Result  := COK;
+            end;
+          -1:
+            begin
+              case ANode^.Children[CRight]^.Children[CLeft]^.Balance of
+                -1:
+                  begin
+                    ANode^.Balance                    := 0;
+                    ANode^.Children[CRight]^.Balance  := 1;
+                  end;
+                0:
+                  begin
+                    ANode^.Balance                    := 0;
+                    ANode^.Children[CRight]^.Balance  := 0;
+                  end;
+                1:
+                  begin
+                    ANode^.Balance                    := -1;
+                    ANode^.Children[CRight]^.Balance  := 0;
                   end;
               end;
 
+              ANode^.Children[CRight]^.Children[CLeft]^.Balance := 0;
+              RotateRight(ANode^.Children[CRight]);
+              RotateLeft(ANode);
+              Result  := CBalance;
+            end;
+        end;
+      end;
+  end;
+end;
+
+function TX2UtCustomBTree.DeleteRightShrunk;
+begin
+  case ANode^.Balance of
+    1:
+      begin
+        ANode^.Balance  := 0;
+        Result          := CBalance;
+      end;
+    0:
+      begin
+        ANode^.Balance  := -1;
+        Result          := COK;
+      end;
+    -1:
+      begin
+        case ANode^.Children[CLeft]^.Balance of
+          -1:
+            begin
+              if ANode^.Children[CLeft]^.Balance = 0 then
+                ANode^.Balance  := 1
+              else
+                ANode^.Balance  := 0;
+
+              RotateRight(ANode);
+              Result  := CBalance;
+            end;
+          0:
+            begin
+              ANode^.Balance                  := -1;
+              ANode^.Children[CLeft]^.Balance := 1;
+              RotateRight(ANode);
+              Result  := COK;
+            end;
+          1:
+            begin
+              case ANode^.Children[CLeft]^.Children[CRight]^.Balance of
+                -1:
+                  begin
+                    ANode^.Balance                  := 1;
+                    ANode^.Children[CLeft]^.Balance := 0;
+                  end;
+                0:
+                  begin
+                    ANode^.Balance                  := 0;
+                    ANode^.Children[CLeft]^.Balance := 0;
+                  end;
+                1:
+                  begin
+                    ANode^.Balance                  := 1;
+                    ANode^.Children[CLeft]^.Balance := 0;
+                  end;
+              end;
+
+              ANode^.Children[CLeft]^.Children[CRight]^.Balance := 0;
+              RotateLeft(ANode^.Children[CLeft]);
+              RotateRight(ANode);
+              Result  := CBalance;
+            end;
+        end;
+      end;
+  end;
+end;
+
+function TX2UtCustomBTree.DeleteFindHighest;
+var
+  pSwap:        PX2UtBTreeNode;
+
+begin
+  AResult := CBalance;
+  Result  := False;
+
+  if not Assigned(ANode) then
+    exit;
+
+  if Assigned(ANode^.Children[CRight]) then
+  begin
+    if not DeleteFindHighest(ATarget, ANode^.Children[CRight], AResult) then
+    begin
+      Result  := False;
       exit;
     end;
 
-  pNode   := Root;
+    if AResult = CBalance then
-  while Assigned(pNode) do
+      AResult := DeleteRightShrunk(ANode);
-  begin
+
-    if AIndex = pNode^.Index then
+    Result  := True;
-    begin
+    exit;
-      Result  := pNode;
-      break;
-    end else if AIndex < pNode^.Index then
-    begin
-      if Assigned(pNode^.Left) then
-        pNode := pNode^.Left
-      else
-      begin
-        if ACanCreate then
-        begin
-          InitNode(pNode^.Left);
-          Result          := pNode^.Left;
-          Result^.Index   := AIndex;
-          Result^.Parent  := pNode;
   end;
 
-        break;
+  pSwap   := ANode;
-      end;
+  CopyNodeData(ANode, ATarget);
-    end else
+  
+  ANode   := ANode^.Children[CLeft];
+  FreeNode(pSwap);
+  Result  := True;
+end;
+
+function TX2UtCustomBTree.DeleteFindLowest;
+var
+  pSwap:        PX2UtBTreeNode;
+
+begin
+  AResult := CBalance;
+  Result  := False;
+
+  if not Assigned(ANode) then
+    exit;
+
+  if Assigned(ANode^.Children[CLeft]) then
   begin
-      if Assigned(pNode^.Right) then
+    if not DeleteFindLowest(ATarget, ANode^.Children[CLeft], AResult) then
-        pNode := pNode^.Right
-      else
     begin
-        if ACanCreate then
+      Result  := False;
-        begin
+      exit;
-          InitNode(pNode^.Right);
-          Result          := pNode^.Right;
-          Result^.Index   := AIndex;
-          Result^.Parent  := pNode;
     end;
 
-        break;
+    if AResult = CBalance then
-      end;
+      AResult := DeleteLeftShrunk(ANode);
-    end;
+
+    Result  := True;
+    exit;
   end;
 
-  if ASetCursor and Assigned(Result) then
+  pSwap   := ANode;
+  CopyNodeData(ANode, ATarget);
+
+  ANode   := ANode^.Children[CRight];
+  FreeNode(pSwap);
+  Result  := True;
+end;
+
+
+function TX2UtCustomBTree.InternalDeleteNode;
+var
+  iResult:      Integer;
+
+begin
+  if AIndex < ARoot^.Index then
   begin
-    // Trace parents
+    // Continue on the left side
-    Parent.Clear();    
+    iResult := InternalDeleteNode(ARoot^.Children[CLeft], AIndex);
-    pNode := Result^.Parent;
+    if iResult = CBalance then
-    while Assigned(pNode) do
     begin
-      Parent.Push(pNode);
+      Result  := DeleteLeftShrunk(ARoot);
-      pNode := pNode^.Parent;
+      exit;
     end;
 
-    // Parents are now in reverse order
+    Result  := iResult;
-    Parent.Reverse();
+    exit;
   end;
+
+  if AIndex > ARoot^.Index then
+  begin
+    // Continue on the right side
+    iResult := InternalDeleteNode(ARoot^.Children[CRight], AIndex);
+    if iResult = CBalance then
+    begin
+      Result  := DeleteRightShrunk(ARoot);
+      exit;
+    end;
+
+    Result  := iResult;
+    exit;
+  end;
+
+  if Assigned(ARoot^.Children[CLeft]) then
+    if DeleteFindHighest(ARoot, ARoot^.Children[CLeft], iResult) then
+    begin
+      if iResult = CBalance then
+        iResult := DeleteLeftShrunk(ARoot);
+
+      Result  := iResult;
+      exit;
+    end;
+
+  if Assigned(ARoot^.Children[CRight]) then
+    if DeleteFindLowest(ARoot, ARoot^.Children[CRight], iResult) then
+    begin
+      if iResult = CBalance then
+        iResult := DeleteRightShrunk(ARoot);
+
+      Result  := iResult;
+      exit;
+    end;
+
+  FreeNode(ARoot);
+  Result  := CBalance;
+end;
+
+procedure TX2UtCustomBTree.DeleteNode;
+begin
+  if not Assigned(FRoot) then
+    exit;
+
+  InternalDeleteNode(FRoot, AIndex);
 end;
 
 
@@ -388,45 +835,43 @@ begin
   Assert(DataSize > 0, RSInvalidDataSize);
   GetMem(ANode, TotalSize);
   FillChar(ANode^, TotalSize, #0);
+
+  Inc(FCount);
+  ClearCursor();
 end;
 
 procedure TX2UtCustomBTree.FreeNode;
 begin
-  if Assigned(ANode^.Left) then
-    FreeNode(ANode^.Left);
-
-  if Assigned(ANode^.Right) then
-    FreeNode(ANode^.Right);
-
-  if Assigned(ANode^.Parent) then
-    if ANode^.Parent^.Left = ANode then
-      ANode^.Parent^.Left   := nil
-    else if ANode^.Parent^.Right = ANode then
-      ANode^.Parent^.Right  := nil
-    else
-      Assert(False, RSOrphanNode);
-
   FreeMem(ANode, TotalSize);
-  ClearCursor();
-
   ANode := nil;
+
+  Dec(FCount);
+  ClearCursor();
 end;
 
 
 procedure TX2UtCustomBTree.Clear;
+  procedure ClearNode(var ANode: PX2UtBTreeNode);
+  begin
+    if Assigned(ANode^.Children[CLeft]) then
+      ClearNode(ANode^.Children[CLeft]);
+
+    if Assigned(ANode^.Children[CRight]) then
+      ClearNode(ANode^.Children[CRight]);
+
+    FreeNode(ANode);
+  end;
+
 begin
   if Assigned(FRoot) then
-    FreeNode(FRoot);
+    ClearNode(FRoot);
+    
+  FRoot := nil;
 end;
 
 procedure TX2UtCustomBTree.Delete;
-var
-  pItem:      PX2UtBTreeNode;
-
 begin
-  pItem := LookupNode(AIndex);
+  DeleteNode(AIndex);
-  if Assigned(pItem) then
-    FreeNode(pItem);
 end;
 
 function TX2UtCustomBTree.Exists;
@@ -475,39 +920,40 @@ begin
 
   if not IsReset then
   begin
-    if Assigned(Cursor^.Left) then
+    if Assigned(Cursor^.Children[CLeft]) then
     begin
       // Valid left path, follow it
-      Parent.Push(Cursor);
+      Parents.Push(Cursor);
-      Cursor  := Cursor^.Left;
+      Cursor  := Cursor^.Children[CLeft];
       Result  := True;
-    end else if Assigned(Cursor^.Right) then
+    end else if Assigned(Cursor^.Children[CRight]) then
     begin
       // Valid right path, follow it
-      Parent.Push(Cursor);
+      Parents.Push(Cursor);
-      Cursor  := Cursor^.Right;
+      Cursor  := Cursor^.Children[CRight];
       Result  := True;
     end else
     begin
       // Neither is valid, traverse back up the parent stack until
       // a node if found with a sibling
       pCurrent  := Cursor;
-      pParent   := Parent.Pop();
+      pParent   := Parents.Pop();
       ClearCursor();
 
       while Assigned(pParent) do
       begin
-        if Assigned(pParent^.Right) and (pParent^.Right <> pCurrent) then
+        if Assigned(pParent^.Children[CRight]) and
+           (pParent^.Children[CRight] <> pCurrent) then
         begin
           // Parent has a sibling, follow it
-          Parent.Push(pParent);
+          Parents.Push(pParent);
-          Cursor  := pParent^.Right;
+          Cursor  := pParent^.Children[CRight];
           Result  := True;
           break;
         end;
 
         pCurrent  := pParent;
-        pParent   := Parent.Pop();
+        pParent   := Parents.Pop();
       end;
     end;
   end else

X2UtHashes.pas

@@ -177,8 +177,6 @@ var
   pValue:     PChar;
 
 begin
-  Result  := 0;
-
   iA      := $9e3779b9;
   iB      := iA;
   iC      := iA;
@@ -377,19 +375,10 @@ end;
 
 
 function TX2UtCustomHash.GetCurrentKey;
-var
-  pKey:       PString;
-
 begin
   Result  := '';
   if ValidCursor(True) then
-  begin
     Result  := HashCursor^.Key;
-    {
-    pKey    := GetNodeInternal(Cursor);
-    Result  := pKey^;
-    }
-  end;
 end;
 
 
@@ -537,9 +526,6 @@ end;
 
 
 function TX2UtStringHash.GetCurrentValue;
-var
-  pData:        PString;
-
 begin
   if ValidCursor() then
     Result  := PString(GetItemData(HashCursor))^;