Metamorphing Machine I rather be this walking metamorphosis
than having that old formed opinion about everything!

A hail to an unsung hero

Visual Basic has a Collection object since its version 4.
Its API is deceptively simple: Item is hidden by default, so it looks like we are dealing with an array on steroids:

Dim Ducks As New Collection

Ducks.Add "Huey"
Ducks.Add "Dewey"
Ducks.Add "Louie"
MsgBox Ducks(1) '<-HERE

Some of its features:
Elements are kept in the insertion order.
The index is one-based.
Keys are strings.
Its elements do not need to be homogeneous. They can be anything:

Unrelated.Add True
Unrelated.Add 3.14159
Unrelated.Add Nothing
Unrelated.Add #01/01/2000#
Unrelated.Add Null

And we can For Each them:

Dim Ducks As New Collection
Dim Duck As Variant

Ducks.Add "Huey"
Ducks.Add "Dewey"
Ducks.Add "Louie"

For Each Duck In Ducks
MsgBox Duck
Next

For Each works because Collection implements the IEnumVARIANT interface.
It is exposed through a NewEnum method, although NewEnum itself is hidden.

Collection has its limitations, too. There's no Clear method, for instance, but that's easily workaroundable. Just New a new Collection into the old one.
Internally, keys are case-sensitive compared to each other. No way to opt-out of that.
If one did not provide a key while inserting an element, then there's no way to figure out what the automagically generated key was.
It does not allow to change an element by another keeping the same key:

Dim Ducks As New Collection

Ducks.Add "Donald", "Duck1"
Ducks.Add "Dewey", "Duck2"
Ducks.Add "Louie", "Duck3"

Rem The statement below will raise a weird "Object required" error.
Ducks("Duck1") = "Huey"

Rem That's the way you do it.
Ducks.Remove "Duck1"
Ducks.Add "Huey", "Duck1", Before:="Duck2"

But it was the workhorse for anything related to keeping a bunch of things together.
It was powerful, and its shortcomings were manageable.
Once I even created a Collection-based class that would raise an error when adding an element with a data type different from the one configured.
Here I offer a nod to all the functionality it provided through the decades! Well done, Collection, well done. 👊

But we have to move on. So far, we have not only used Collection in our program, but also its young brother, Dictionary.
If this project is ever to be successful, sometime in the future we will have (maybe) to implement a Collection ourselves.
And that's what we will do now.
As good names are hard to come up, I'll call it KeyedList. Here it is its implementation:

Class KeyedList
Private ID_ As Long
Private Count_ As Long
Private Root_ As KLNode
Private Last_ As KLNode

Public Base As Integer
Public CompareMode As VbCompareMethod


Private Sub Class_Initialize()
ID_ = &H80000000
Base = 1
End Sub


Private Sub Class_Terminate()
Clear
End Sub


Public Sub AddKeyValue(ByVal Key As String, ByVal Item As Variant)
Add Item, Key
End Sub


Public Sub Add(ByVal Item As Variant, Optional ByVal Key As Variant)
Const ID = "72E0DEDF0CD34921A650C8DD99F21A68_"
Dim NewKey As String
Dim NewNode As KLNode

Select Case VarType(Key)
Case vbString
NewKey = CStr(Key)

Case vbError
If Not IsMissing(Key) Then Err.Raise 13

NewKey = ID & Hex$(ID_)
ID_ = ID_ + 1

Case Else
Err.Raise 13
End Select

If Root_ Is Nothing Then
Set Root_ = New KLNode
Root_.Key = NewKey
If IsObject(Item) Then Set Root_.Value = Item Else Root_.Value = Item
Set Last_ = Root_

Else
If Not FindNode(NewKey) Is Nothing Then Err.Raise 457

Set NewNode = New KLNode
NewNode.Key = NewKey
If IsObject(Item) Then Set NewNode.Value = Item Else NewNode.Value = Item

Set Last_.NextNode = NewNode
Set Last_ = NewNode
End If

Count_ = Count_ + 1
End Sub


Public Property Get Count() As Long
Count = Count_
End Property


Public Default Property Get Item(ByVal Index As Variant) As Variant
Dim Node As KLNode

Set Node = FindNode(Index)
If Node Is Nothing Then Err.Raise 5
If IsObject(Node.Value) Then Set Item = Node.Value Else Item = Node.Value
End Property


Public Property Get Exists(ByVal Key As String) As Boolean
Exists = Not FindNode(Key) Is Nothing
End Property


Public Sub Remove(ByVal Index As Variant)
Dim Found As Boolean
Dim Idx As Long
Dim Key As String
Dim CurNode As KLNode
Dim PrvNode As KLNode

Set CurNode = Root_

If VarType(Index) = vbString Then
Key = CStr(Index)

Do Until CurNode Is Nothing
If StrComp(CurNode.Key, Key, CompareMode) = 0 Then
If Not PrvNode Is Nothing Then Set PrvNode.NextNode = CurNode.NextNode
Found = True
Exit Do
End If

Set PrvNode = CurNode
Set CurNode = CurNode.NextNode
Loop
Else
Idx = CLng(Index)
Idx = Idx - Base

Do Until CurNode Is Nothing
If Idx = 0 Then
If CurNode Is Root_ Then
Set Root_ = CurNode.NextNode

ElseIf Not PrvNode Is Nothing Then
Set PrvNode.NextNode = CurNode.NextNode
End If

If CurNode Is Last_ Then Set Last_ = PrvNode
Found = True
Exit Do
End If

Idx = Idx - 1
Set PrvNode = CurNode
Set CurNode = CurNode.NextNode
Loop
End If

If Found Then Count_ = Count_ - 1 Else Err.Raise 5
End Sub


Public Iterator Function NewEnum() As IUnknown
Dim It As KLEnumerator

Set It = New KLEnumerator
Set It.List = Me
Set NewEnum = It.NewEnum
End Function


Public Sub Clear()
Dim CurrNode As KLNode
Dim NextNode As KLNode

Set CurrNode = Root_
Set Root_ = Nothing

Do Until CurrNode Is Nothing
Set NextNode = CurrNode.NextNode
Set CurrNode.NextNode = Nothing
Set CurrNode = NextNode
Loop

Count_ = 0
End Sub


Private Function FindNode(ByVal Index As Variant) As KLNode
Dim Idx As Long
Dim Node As KLNode

If VarType(Index) = vbString Then
Set Node = FindKey(CStr(Index))
Else
Idx = CLng(Index)
Idx = Idx - Base

If Idx >= 0 Then
Set Node = Root_
Do Until Node Is Nothing Or Idx = 0
Set Node = Node.NextNode
Idx = Idx - 1
Loop
End If
End If

Set FindNode = Node
End Function


Private Function FindKey(ByVal Key As String) As KLNode
Dim Node As KLNode

Set Node = Root_

Do Until Node Is Nothing
If StrComp(Node.Key, Key, CompareMode) = 0 Then
Set FindKey = Node
Exit Function
End If

Set Node = Node.NextNode
Loop
End Function


Public Sub AddValues(ParamArray Values() As Variant)
Dim Value As Variant

For Each Value In Values
Add Value
Next
End Sub


Public Sub AddKVPairs(ParamArray KeyValuePairs() As Variant)
Dim Idx As Long
Dim Udx As Long

Udx = UBound(KeyValuePairs)
If Udx Mod 2 = 0 Then Err.Raise 5

For Idx = 0 To Udx Step 2
Add KeyValuePairs(Idx + 1), KeyValuePairs(Idx)
Next
End Sub
End Class


Class KLNode
Public NextNode As KLNode
Public Key As String
Public Value As Variant
End Class

There are a few things worth noting:

I created a property Base to let the starting index for the collection be user-configurable.
By default, it is one.

I copied Dictionary's CompareMode, Exists, and Clear methods to our KeyedList.

Our Add method is not as versatile as Collection's one, as it does not allow insertion before or after other elements.

I created an AddKeyValue method having the same signature as Dictionary's Add.

I'm using the non-VB6-compatible Default keyword to mark Item as the default method for KeyedList.
I'm also using the Iterator pseudo-keyword to mark NewEnum as implementing the IEnumVARIANT interface.
Finally, I created two handy methods: AddValues to allow us to add elements more compactly:

Dim Ducks As New KeyedList

Ducks.AddValues "Huey", "Dewey", "Louie"

And AddKVPairs to add a sequence of keys and values:

Dim Ducks As New KeyedList

Ducks.AddKVPairs "Duck1", "Huey", "Duck2", "Dewey", "Duck3", "Louie"

It uses internally a single linked list to keep its elements and keys, and I can easily see me translating it to C, for instance.

Finally, as I promised last week, we made it For Eachable using the VariantEnumerator class.
KeyedList uses a KLEnumerator class that uses the VariantEnumerator class. Here it is its implementation:

Class KLEnumerator
Private Index_ As Long
Private List_ As KeyedList
Private WithEvents VbEnum As VariantEnumerator


Public Property Set List(ByVal Value As KeyedList)
Set List_ = Value
Index_ = List_.Base
Set VbEnum = New VariantEnumerator
End Property


Public Iterator Function NewEnum() As IUnknown
Set NewEnum = VbEnum.NewEnum(Me)
End Function


Private Sub VbEnum_Clone(ByRef Obj As Variant, ByRef Data As Variant)
Debug.Assert False
End Sub


Private Sub VbEnum_NextItem(ByVal Qty As Long, ByRef Items As Variant, ByRef Returned As Long, ByRef Data As Variant)
If Index_ > List_.Count Then Exit Sub

If IsObject(List_(Index_)) Then Set Items = List_(Index_) Else Items = List_(Index_)
Index_ = Index_ + 1
Returned = 1
End Sub


Private Sub VbEnum_Reset(ByRef Data As Variant)
Index_ = List_.Base
End Sub


Private Sub VbEnum_Skip(ByVal Qty As Long, ByRef Data As Variant)
Index_ = Index_ + Qty
End Sub
End Class

It showcases how to use VariantEnumerator:
Ant that's it. KeyedList is now For Eachable.

One last note: KeyedList probably is slow.
I hope someday someone way smarter than me improve it to use, I don't know, B-Trees, maybe?
Now what's left is replace all collections and dictionaries we used by KeyedList and change several .Add calls to .AddKeyValue.

Next week we'll have a surprising return of WTF, VB6!

Andrej Biasic
2020-12-30