This is an implementation of Mat's List using by Pseudo-inheriting my Pythonic-List. Inheritance is not built into VBA, but it can be simulated by composing the inherited class and mimicking all it's public methods and members. It's a PITA because a modification of a base class needs to be propagated to all sub-classes.
The implementation is simple, just add a private string data member pTypedName
, and whenever the client code tries to add an element where TypeName(Element) <> pTypedName
raise a type error.
TypedList
Private Members
Private this As List
Private pTypedName As String
Private Methods
Type Check an element that is being added to a list. If the type has not been set then let this element set the typename. Otherwise, raise an error if it's not the correct type.
Private Sub TypeCheck(ByVal element As Variant, ByVal source As String)
If pTypedName = vbNullString Then pTypedName = TypeName(element)
If (TypeName(element) <> pTypedName) Then RaiseTypeError element, source
End Sub
Therefore
Dim tList as New TypedList
tList.Append "A"
Is valid and now tList
is of type String.
We also want to check every element in a sequence before we let any of the elements enter the list. If our string list is extended with Array("a", "b", "C", 2)
we don't want any of the elements entering the list.
Private Sub TypeCheckSequence(ByVal sequence As Variant, ByVal source As String)
Dim element As Variant
For Each element In sequence
TypeCheck element, source
Next element
End Sub
The above two methods are boiler plate code at the beginning of any method that sets the data in our TypedList.
This is the error that is raised when it fails.
Private Sub RaiseTypeError(ByVal badItem As Variant, ByVal method As String)
Err.Raise 13, method, "Element is of type " & TypeName(badItem) & _
", not " & TypedName & "."
End Sub
Enumeration
Note we use this.NewEnum
instead of this.[_NewEnum]
as was in the List
class.
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Set NewEnum = this.NewEnum
End Property
Public Methods
Client code can ask TypedList what it's type is and set the type only if the list is empty.
Public Property Get TypedName() As String
TypedName = pTypedName
End Property
Public Property Let TypedName(ByVal typeName_ As String)
If this.Count > 0 Then
Err.Raise 9, TypeName(Me) & ".TypedName", _
"Can only set typename of an empty list."
End If
pTypedName = typeName_
End Property
After this it's fairly boring and redundant. I wish I wasn't required to write all of this out.
TypeCheck Entrances
Mimic all entry points with the type checking BoilerPlate code.
Replacement
Public Property Let Item(ByVal index As Long, ByVal element As Variant)
Attribute Item.VB_UserMemId = 0
TypeCheck element, TypeName(Me) & ".Item"
this.Item(index) = element
End Property
Public Property Set Item(ByVal index As Long, ByVal element As Variant)
Attribute Item.VB_UserMemId = 0
TypeCheck element, TypeName(Me) & ".Item"
Set this.Item(index) = element
End Property
Public Property Let Slice(ByVal a As Long, ByVal b As Long, ByVal s As Integer, ByVal sequence As Variant)
TypeCheckSequence sequence, TypeName(Me) & ".Slice"
this.Slice(a, b, s) = sequence
End Property
Extension
Public Sub Append(ByVal element As Variant)
TypeCheck element, TypeName(Me) & ".Append"
this.Append element
End Sub
Public Sub Extend(ByVal sequence As Variant)
TypeCheckSequence sequence, TypeName(Me) & ".Extend"
this.Extend sequence
End Sub
Insertion
Public Sub Emplace(ByVal index As Long, ByVal element As Variant)
TypeCheck element, TypeName(Me) & ".Emplace"
this.Emplace index, element
End Sub
Public Sub Insert(ByVal index As Long, ByVal sequence As Variant)
TypeCheckSequence sequence, TypeName(Me) & ".Insert"
collec.Insert sequence, index
End Sub
Default Interfaces
Now it's just mimic all the other methods. Even more boring...
Access
Public Property Get Item(ByVal index As Long) As Variant
Attribute Item.VB_UserMemId = 0
seq.Assign Item, this.Item(index)
End Property
Public Property Get Slice(ByVal a As Long, ByVal b As Long, ByVal s As Integer) As List
Set Slice = this.Slice(a, b, s)
End Property
Removal
Public Sub Remove(ByVal index As Long)
this.Remove index
End Sub
Public Sub Clear(ByVal start As Long, ByVal size As Long)
this.Clear start, size
End Sub
Aux
Public Function Count() As Long
Count = this.Count
End Function
Public Function Exists(ByVal sought As Variant) As Boolean
Exists = this.Exists(sought)
End Function
Public Function ToString() As String
ToString = this.ToString
End Function