1 Attribute VB_Name = "Bin"
4 ' binary tree algorithm, object method
6 Private Root As CBin ' root of binary tree
8 Private Function FindNode(ByVal KeyVal As Variant) As CBin
10 ' KeyVal key of node to find
14 ' Finds node with key KeyVal.
19 ' find node specified by key
21 Do While Not x Is Nothing
22 If x.Key = KeyVal Then
26 If KeyVal < x.Key Then
33 Raise errKeyNotFound, "Bin.FindNode"
36 Public Sub Insert(ByVal KeyVal, ByRef RecVal As Variant)
38 ' KeyVal key of node to insert
39 ' RecVal record associated with key
41 ' Inserts record RecVal with key KeyVal.
49 ' allocate node for data and insert in tree
54 Do While Not current Is Nothing
55 If current.Key = KeyVal Then Raise errDuplicateKey, "Bin.Insert"
57 If KeyVal < current.Key Then
58 Set current = current.Left
60 Set current = current.Right
75 If Not Parent Is Nothing Then
76 If x.Key < Parent.Key Then
86 Public Sub Delete(ByVal KeyVal As Variant)
88 ' KeyVal key of node to delete
90 ' Deletes record with key KeyVal.
98 Set z = FindNode(KeyVal)
100 ' delete node z from tree
102 ' find tree successor
103 If z.Left Is Nothing Or z.Right Is Nothing Then
107 Do While Not y.Left Is Nothing
112 ' x is y's only child
113 If Not y.Left Is Nothing Then
119 ' remove y from the parent chain
120 If Not x Is Nothing Then Set x.Parent = y.Parent
121 If Not y.Parent Is Nothing Then
122 If y Is y.Parent.Left Then
123 Set y.Parent.Left = x
125 Set y.Parent.Right = x
131 ' if z and y are not the same, replace z with y.
134 If Not y.Left Is Nothing Then Set y.Left.Parent = y
135 Set y.Right = z.Right
136 If Not y.Right Is Nothing Then Set y.Right.Parent = y
137 Set y.Parent = z.Parent
138 If Not z.Parent Is Nothing Then
139 If z Is z.Parent.Left Then
140 Set z.Parent.Left = y
142 Set z.Parent.Right = y
147 ' z is no longer referenced, and is automatically freed
149 ' y is no longer referenced, and is automatically freed
153 Public Function Find(ByVal KeyVal) As Variant
155 ' KeyVal key of node to delete
157 ' record associated with key
159 ' Finds record with key KeyVal
163 Find = FindNode(KeyVal).Rec
173 Private Sub ZapNode(x As CBin)
177 ' recursively set x's parents to Nothing
179 If x Is Nothing Then Exit Sub
180 Set x.Parent = Nothing
189 If Root Is Nothing Then Exit Sub
191 ' remove all parent pointers
195 ' now, freeing root will free whole tree