Wednesday, December 17, 2008

[vb6] Wrap your collections

You can wrap the VBA collection type in a class of your own, and thereby tailor it for any specific use. Paste the code below into a new class module; set the Item property to be the default. Give the NewEnum method a procedure ID of -4 and click the "Hide member" checkbox in the Procedure Attributes dialog. Note that this example is for collecting class objects; that's why the 'Set' keyword is required in the Item Get property. If you are collecting anything else than objects, remove the 'Set'.
This generalized example can be used as a template for generating more specific collection wrappers; for example you may want to replace the Variant type for the object parameters with something more specific and to let the class generate unique strings to use for the keys, or incorporate any other rules into it as it applies. One shortcoming of the VBA collection is the Item method - it is implemented as a method rather than a property. That means that you cannot go: Let TheCollection("key") = MyObject. Instead you have to first remove the object with key "key" and then add MyObject under the same key. That behaviour has been corrected in this example by implementing Item as a property with let and get procedures.
    Option Explicit
Private m_Col As Collection

Public Property Get Count() As Long
Count = m_Col.Count
End Property

Public Sub Add(ByVal NewItem As Variant, ByVal key As Variant)
On Error GoTo ERR_HAND
m_Col.Add NewItem, key
ERR_HAND:
Exit Sub
Err.Raise Err.Number, "MyCollection Class", Err.Description
End Sub

Public Sub Remove(ByVal key As Variant)
On Error GoTo ERR_HAND
m_Col.Remove key
ERR_HAND:
Exit Sub
Err.Raise Err.Number, "MyCollection Class", Err.Description
End Sub

Public Property Let Item(ByVal key As Variant, ByVal NewItem As Variant)
On Error Resume Next
m_Col.Remove key
On Error GoTo ERR_HAND
m_Col.Add NewItem, key
ERR_HAND:
Exit Property
Err.Raise Err.Number, "MyCollection Class", Err.Description
End Property

Public Property Get Item(ByVal key As Variant) As Variant
On Error GoTo ERR_HAND
Set Item = m_Col(key)
Exit Property
ERR_HAND:
Err.Raise Err.Number, "MyCollection Class", Err.Description
End Property

Public Function NewEnum() As IUnknown
Set NewEnum = m_Col.[_NewEnum]
End Function

Private Sub Class_Initialize()
Set m_Col = New Collection
End Sub

No comments:

Post a Comment