Recently I decided VB6's Collection wasn't enough for my needs, so I decided to implement something like C#'s List<T>. Here's the class that resulted, I'd like to know if the implementation could be made better /more efficient, especially with Insert and Sort methods; also I'd like another pair of eyes to examine the errors being raised and see if it all makes sense - the idea isn't to throw every error that's possible to get with a List<T>, but I might have missed throwing an error that could help usability.
I've been using this List class in VB6 code for a little less than a week now, and seriously, it's like the best thing since sliced bread - being able to add items inline is awesome, and all those members make Collection look awfully boring and make me want to implement a keyed version, which I'm guessing could wrap a Dictionary instead.
Class definition and private functions
As with all classes I write, I start with declaring a Private Type that defines what the class encapsulates, and then I make a private instance of that type which I call this and in the rest of the code I refer to this, which does not have the same meaning as Me (Me refers to the current instance of the List class, while this refers to the encapsulated stuff - as you'll notice I only use Me when I have to).
I have a debate with myself as to whether the RaiseErrorXXXX procedures should be made public or not - doing so would document the errors thrown at the API level, but wouldn't serve any real purpose.
Attribute VB_Name = "List"
Private Type tList
Encapsulated As Collection
ItemTypeName As String
End Type
Private this As tList
Option Explicit
Private Function IsReferenceType() As Boolean
If Count = 0 Then Exit Function
IsReferenceType = IsObject(this.Encapsulated(1))
End Function
Private Function IsComparable() As Boolean
If IsReferenceType Then
IsComparable = TypeOf First Is IComparable
End If
End Function
Private Function CompareReferenceTypes(value As Variant, other As Variant) As Integer
Dim comparable As IComparable
If IsComparable Then
Set comparable = value
CompareReferenceTypes = comparable.CompareTo(other)
Else
RaiseErrorMustImplementIComparable "CompareReferenceTypes()"
End If
End Function
Private Function CompareValueTypes(value As Variant, other As Variant) As Integer
If value < other Then
CompareValueTypes = -1
ElseIf value > other Then
CompareValueTypes = 1
End If
End Function
Private Function IsEquatable() As Boolean
If IsReferenceType Then
IsEquatable = TypeOf First Is IEquatable
End If
End Function
Private Function EquateReferenceTypes(value As Variant, other As Variant) As Boolean
Dim equatable As IEquatable
If IsEquatable Then
Set equatable = value
EquateReferenceTypes = equatable.Equals(other)
Else
Debug.Print "WARNING: Reference type doesn't implement IEquatable, using reference equality."
EquateReferenceTypes = (ObjPtr(value) = ObjPtr(other))
End If
End Function
Private Function EquateValueTypes(value As Variant, other As Variant) As Boolean
EquateValueTypes = (value = other)
End Function
Private Function ValidateItemType(value As Variant)
If this.ItemTypeName = vbNullString Then this.ItemTypeName = TypeName(value)
ValidateItemType = IsTypeSafe(value)
End Function
Private Sub RaiseErrorUnsafeType(member As String, suppliedType As String)
Err.Raise 13, StringFormat("{0}.{1}", ToString, member), _
StringFormat("Type Mismatch. Expected: '{0}', '{1}' was supplied.", this.ItemTypeName, suppliedType)
End Sub
Private Sub RaiseErrorMustImplementIComparable(member As String)
Err.Raise 5, StringFormat("{0}.{1}", ToString, member), "Invalid operation: method requires a list of numeric, date or string values, or a list of objects implementing the IComparable interface."
End Sub
Private Sub Class_Initialize()
Set this.Encapsulated = New Collection
End Sub
Private Sub Class_Terminate()
Set this.Encapsulated = Nothing
End Sub
Public Properties
Public Property Get Item(ByVal Index As Long) As Variant
Attribute Item.VB_UserMemId = 0
'Gets the element at the specified index.
If IsReferenceType Then
Set Item = this.Encapsulated(Index)
Else
Item = this.Encapsulated(Index)
End If
End Property
Public Property Let Item(ByVal Index As Long, ByVal value As Variant)
'Sets the element at the specified index.
If Not IsTypeSafe(value) Then RaiseErrorUnsafeType "Item(Let)", TypeName(value)
RemoveAt Index
If Index = Count Then
Add value
Else
Insert Index, value
End If
End Property
Public Property Set Item(ByVal Index As Long, ByVal value As Variant)
'Sets the element at the specified index.
If Not IsTypeSafe(value) Then RaiseErrorUnsafeType "Item(Set)", TypeName(value)
RemoveAt Index
If Index = Count Then
Add value
Else
Insert Index, value
End If
End Property
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
'Gets an enumerator that iterates through the List.
Set NewEnum = this.Encapsulated.[_NewEnum]
End Property
Public Property Get Count() As Long
Count = this.Encapsulated.Count
End Property
Public Methods/Functions
Those are listed in alphabetical order:Public Sub Add(value As Variant)
'Adds an object to the end of the List.
If Not ValidateItemType(value) Then RaiseErrorUnsafeType "Add()", TypeName(value)
this.Encapsulated.Add value
End Sub
Public Sub AddArray(values() As Variant)
'Adds the specified elements to the end of the List.
Dim value As Variant, i As Long
For i = LBound(values) To UBound(values)
Add values(i)
Next
End Sub
Public Sub AddRange(ByRef values As List)
'Adds the specified elements to the end of the List.
Dim value As Variant
For Each value In values
Add value
Next
End Sub
Public Sub AddValues(ParamArray values())
'Adds the specified elements to the end of the List.
Dim value As Variant, i As Long
For i = LBound(values) To UBound(values)
Add values(i)
Next
End Sub
Public Sub Clear()
'Removes all elements from the List.
Do Until Count = 0
this.Encapsulated.Remove 1
Loop
End Sub
Public Function Contains(value As Variant) As Boolean
'Determines whether an element is in the List.
Contains = (IndexOf(value) <> -1)
End Function
Public Function First() As Variant
'Returns the first element of the List.
If Count = 0 Then Exit Function
If IsReferenceType Then
Set First = Item(1)
Else
First = Item(1)
End If
End Function
Public Function GetRange(ByVal Index As Long, ByVal valuesCount As Long) As List
'Creates a copy of a range of elements in the source List.
Dim result As List
If Index > Count Then Err.Raise 9 'index out of range
Dim lastIndex As Long
lastIndex = IIf(Index + valuesCount > Count, Count, Index + valuesCount)
Set result = New List
Dim i As Long
For i = Index To lastIndex
result.Add Item(i)
Next
Set GetRange = result
End Function
Public Function IndexOf(value As Variant) As Long
'Searches for the specified object and returns the 1-based index of the first occurrence within the entire List.
Dim found As Boolean
Dim isRef As Boolean
isRef = IsReferenceType
Dim i As Long
If Count = 0 Then IndexOf = -1: Exit Function
For i = 1 To Count
If isRef Then
found = EquateReferenceTypes(value, Item(i))
Else
found = EquateValueTypes(value, Item(i))
End If
If found Then IndexOf = i: Exit Function
Next
IndexOf = -1
End Function
Public Sub Insert(ByVal Index As Long, value As Variant)
'Inserts an element into the List at the specified index.
Dim tmp As List
Set tmp = GetRange(Index, Count)
RemoveRange Index, Count
Add value
AddRange tmp
End Sub
Public Sub InsertArray(ByVal Index As Long, values() As Variant)
'Inserts the specified elements into the List at the specified index.
Dim tmp As List
Set tmp = GetRange(Index, Count)
RemoveRange Index, Count
AddArray values
AddRange tmp
End Sub
Public Sub InsertRange(ByVal Index As Long, values As List)
'Inserts the specified elements into the List at the specified index.
Dim tmp As List
Set tmp = GetRange(Index, Count)
RemoveRange Index, Count
AddRange values
AddRange tmp
End Sub
Public Sub InsertValues(ByVal Index As Long, ParamArray values())
'Inserts the specified elements into the List at the specified index.
Dim valuesArray() As Variant
valuesArray = values
InsertArray Index, valuesArray
End Sub
Public Function IsSortable() As Boolean
'Determines whether the List can be sorted.
If Count = 0 Then Exit Function
Dim firstItem As Variant
If IsReferenceType Then
Set firstItem = First
Else
firstItem = First
End If
IsSortable = IsNumeric(firstItem) _
Or IsDate(firstItem) _
Or this.ItemTypeName = "String" _
Or IsComparable
End Function
Public Function IsTypeSafe(value As Variant) As Boolean
'Determines whether a value can be safely added to the List.
'Returns true if the type of specified value matches the type of items already in the list,
'or it the type of specified value is a numeric type smaller than the type of items already in the list.
'This means a List<Long> can contain Integer values, but a List<Integer> cannot contain Long values.
Dim result As Boolean
'most common cases: this.ItemTypeName isn't yet defined, or matches TypeName(value):
result = this.ItemTypeName = vbNullString Or this.ItemTypeName = TypeName(value)
If result Then IsTypeSafe = result: Exit Function
'all other cases demand more processing:
IsTypeSafe = result _
Or this.ItemTypeName = "Integer" And StringMatchesAny(TypeName(value), "Byte") _
Or this.ItemTypeName = "Long" And StringMatchesAny(TypeName(value), "Integer", "Byte") _
Or this.ItemTypeName = "Single" And StringMatchesAny(TypeName(value), "Long", "Integer", "Byte") _
Or this.ItemTypeName = "Double" And StringMatchesAny(TypeName(value), "Long", "Integer", "Byte", "Single") _
Or this.ItemTypeName = "Currency" And StringMatchesAny(TypeName(value), "Long", "Integer", "Byte", "Single", "Double")
End Function
Public Function Last() As Variant
'Returns the last element of the List.
If Count = 0 Then Exit Function
If IsReferenceType Then
Set Last = Item(Count)
Else
Last = Item(Count)
End If
End Function
Public Function LastIndexOf(value As Variant) As Long
'Searches for the specified object and returns the 1-based index of the last occurrence within the entire List.
Dim found As Boolean
Dim isRef As Boolean
isRef = IsReferenceType
LastIndexOf = -1
If Count = 0 Then Exit Function
Dim i As Long
For i = 1 To Count
If isRef Then
found = EquateReferenceTypes(value, Item(i))
Else
found = EquateValueTypes(value, Item(i))
End If
If found Then LastIndexOf = i
Next
End Function
Public Function Max() As Variant
'Returns the maximum value in the List.
Dim isRef As Boolean
isRef = IsReferenceType
Dim largest As Variant
Dim isLarger As Boolean
Dim i As Long
For i = 1 To Count
If isRef Then
If IsEmpty(largest) Then Set largest = Item(i)
isLarger = CompareReferenceTypes(Item(i), largest) > 0
If isLarger Or IsEmpty(Max) Then
Set largest = Item(i)
Set Max = largest
End If
Else
If IsEmpty(largest) Then largest = Item(i)
isLarger = CompareValueTypes(Item(i), largest) > 0
If isLarger Or IsEmpty(Max) Then
largest = Item(i)
Max = largest
End If
End If
Next
End Function
Public Function Min() As Variant
'Returns the minimum value in the List.
Dim isRef As Boolean
isRef = IsReferenceType
Dim smallest As Variant
Dim isSmaller As Boolean
Dim i As Long
For i = 1 To Count
If isRef Then
If IsEmpty(smallest) Then Set smallest = Item(i)
isSmaller = CompareReferenceTypes(Item(i), smallest) < 0
If isSmaller Or IsEmpty(Min) Then
Set smallest = Item(i)
Set Min = smallest
End If
Else
If IsEmpty(smallest) Then smallest = Item(i)
isSmaller = CompareValueTypes(Item(i), smallest) < 0
If isSmaller Or IsEmpty(Min) Then
smallest = Item(i)
Min = smallest
End If
End If
Next
End Function
Public Sub Reverse()
'Reverses the order of the elements in the entire List.
Dim tmp As New List
Do Until Count = 0
tmp.Add Item(Count)
RemoveAt Count
Loop
AddRange tmp
End Sub
Public Sub Remove(ParamArray values())
'Removes the first occurrence of specified object(s) from the List.
Dim i As Long
Dim Index As Long
For i = LBound(values) To UBound(values)
Index = IndexOf(values(i))
If Index <> -1 Then RemoveAt Index
Next
End Sub
Public Sub RemoveAt(ByVal Index As Long)
'Removes the element at the specified index of the List.
this.Encapsulated.Remove Index
End Sub
Public Sub RemoveRange(ByVal Index As Long, ByVal valuesCount As Long)
'Removes a range of elements from the List.
Dim i As Long
For i = Index To Index + valuesCount - 1
RemoveAt Index
Next
End Sub
Public Sub Sort()
'Sorts the elements in the entire List.
Dim tmp As List
Dim minValue As Variant
If Not IsSortable Then RaiseErrorMustImplementIComparable "Sort()"
Dim isRef As Boolean
isRef = IsReferenceType
Set tmp = New List
Do Until Count = 0
If isRef Then
Set minValue = Min
Else
minValue = Min
End If
tmp.Add minValue
Remove minValue
Loop
AddRange tmp
End Sub
Public Sub SortDescending()
'Sorts the elements in the entire List, in descending order.
Dim tmp As List
Dim maxValue As Variant
If Not IsSortable Then RaiseErrorMustImplementIComparable "SortDescending()"
Dim isRef As Boolean
isRef = IsReferenceType
Set tmp = New List
Do Until Count = 0
If isRef Then
Set maxValue = Max
Else
maxValue = Max
End If
tmp.Add maxValue
Remove maxValue
Loop
AddRange tmp
End Sub
Public Function ToArray() As Variant()
'Copies the elements of the List to a new array.
Dim result() As Variant
ReDim result(1 To Count)
Dim i As Long
If Count = 0 Then Exit Function
If IsReferenceType Then
For i = 1 To Count
Set result(i) = Item(i)
Next
Else
For i = 1 To Count
result(i) = Item(i)
Next
End If
ToArray = result
End Function
Public Function ToString() As String
'Returns a string that represents the current List object.
ToString = StringFormat("{0}<{1}>", TypeName(Me), Coalesce(this.ItemTypeName, "Variant"))
End Function
Interfaces
This List uses two interfaces adapted from C#, namely IComparable and IEquatable, for the same reasons List<T> needs them - I believe they would work just as well if I changed the instancing from MultiUse to PublicNotCreatable, but that's one foggy area of my VB6 knowledge, so I left it as is:
IComparable:
Option Explicit
Public Function CompareTo(other As Variant) As Integer
End Function
IEquatable:
Option Explicit
Public Function Equals(other As Variant) As Boolean
End Function
A couple helper functions are also used here and there in the class' code - I'm not asking for a review of those, but if you are interested to see more, StringFormat is a custom C#-style VB6/VBA implementation of string.Format() covered here, StringMatchesAny is a custom string helper function covered here, and Coalesce is a simple null-replacement function that considers an empty string as a null value.
Add()should take aParamArrayand callAddArray(), soAddValues()could be removed as redundant, just likeRemove()does. ...And I'm probably missing aRemoveArray()method. Or is that too many "overload" members? \$\endgroup\$Attribute NewEnum.VB_MemberFlags = "40"is not supported in VBA. It's meant to hide the member from Object Browser and Intelli-sense but has no effect. \$\endgroup\$