Context
Usually, when I have to deal with a collection of items (especially objects) I tent to create a container class for that collection (wrapper?). What I mean by that is: when I have to handle multiple clsCar
s objects I collect them inside clsCars
class.
Building blocks
clsCar
Private pModel as String
Private pManufacturer as String
Public Property Get Model() as String
Model = pModel
End Property
Public Property Let Model(ByVal Value as String)
If Value = vbNullString Then
Error.ArgumentException vbNullString, vbNullString
End if
pModel = Value
End Property
Public Property Get Manufacturer() as String
Manufacturer = pManufacturer
End Property
To enforce a collection-like functionality would I implement a custom made ICollection
interface in each container class.
ICollection
Public Sub Add(Byref Item as Object)
End Sub
Public Sub Remove(ByVal Index as Long)
End Sub
Public Function Count() as Long
End Function
Public Function Item(ByVal Index as Long) as Object
End Function
The way I would implement this interface is as following:
clsCars
Public Sub Add(Byref Item as clsCar)
ICollection_Add Item
End Sub
Public Sub Remove(ByVal Index as Long)
ICollection_Remove Index
End Sub
Public Function Count() as Long
Count = ICollection_Count()
End Function
Public Function Item(ByVal Index as Long) as clsCar
Set Item = ICollection_Item(Index)
End Function
Private Sub ICollection_Add(Byref Item as Object)
pContent.Add Item
End Sub
Private Sub ICollection_Remove(ByVal Index as Long)
pContent.Remove Index
End Sub
Private Function ICollection_Count() as Long
ICollection_Count = pContent.Count
End Function
Private Function ICollection_Item(ByVal Index as Long) as Object
Set ICollection_Item = pContent(Index)
End Function
Sometimes, if there is a need to add a many clsCar
objects, I would create an extra AddRange
method.
clsCars
Public Sub AddRange(ByRef Items as clsCars)
If Items is Nothing Then
Error.ArgumentNullException vbNullString, vbNullString
End if
Dim Item as clsCar
For each Item in Items.Content
Me.Add Item
Next Item
Set Item = Nothing
End Sub
Finally, to iterate over items is use this dirty method. pContent
is read-only filed.
clsCars
Private pContent as New Collection
Public Property Get Content() as Collection
Set Content = pContent
End Property
But the clsCars
class is not only responsible for storing clsCar
objects, clsCars
class can also perform simple filtering using properties of clsCar
class and items inside the container. Consider:
clsCars
Public Function FilterByModel(ByVal Model as String) as clsCars
If Model = vbNullString Then
Error.ArgumentException vbNullString, vbNullString
End if
Dim Item as clsCar
Dim Output as New clsCars
For Each Item in pContent
If Item.Model = Model Then
Output.Add Item
End if
Next Item
Set FilterByModel = Output
Set Output = Nothing
Set Item = Nothing
End Function
Public Function FilterByManufacturer(ByVal Manufacturer as String) as clsCars
If Manufacturer = vbNullString Then
Error.ArgumentException vbNullString, vbNullString
End if
Dim Item as clsCar
Dim Output as New clsCars
For Each Item in pContent
If Item.Manufacturer = Manufacturer Then
Output.Add Item
End if
Next Item
Set FilterByManufacturer = Output
Set Output = Nothing
Set Item = Nothing
End Function
Implementing FilterByModel
this way would allow me to do chain-filtering if necessary.
Cars.FilterByManufacturer("Ford").FilterByModel("Focus")
Error
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Error"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public Sub ArgumentNullException(ByVal ParamName As String, ByVal Message As String)
Err.Raise 513, , "Value cannot be null." & vbNewLine & vbNewLine & _
"Additional information: " & Message & vbNewLine & vbNewLine & _
"Parameter: " & ParamName
End Sub
Public Sub ArgumentException(ByVal ParamName As String, ByVal Message As String)
Err.Raise 518, , "An exception of type ArgumentException was thrown." & vbNewLine & vbNewLine & _
"Additional information: " & Message & vbNewLine & vbNewLine & _
"Parameter: " & ParamName
End Sub
My thoughts while I was working on this:
- Each FilterBy[PropertyName] function will be very similar. I could look into this and try to find some common ground/function.
- Container class (in this case
clsCars
) will accept only specific type as an item (clsCars
will not accept, as an item, for example aclsBook
object) - I might end up with a lot of the same code which just does the same thing as
VBA.Collection
. SeeAdd(), Remove(), Count(), Item()
- It would be nice to have function which would select all
clsCar
s ifManufacturer
orModel
matches with the input. Example:MatchOr("Manufacturer = Ford Or Model = Polo")
.
Conclusion
Should I continue doing things this way? Do you see any advantages/disadvantages following this sudo-practice? I hope my lack of proper English does not hurt your eyes too much!
1 Answer 1
To enforce a collection-like functionality would I implement a custom made ICollection interface in each container class.
While an ICollection
interface is nice in theory, in practice it doesn't really play nicely with how VBA implements enumerables. The single main advantage of using an object collection is its ability to leverage [_NewEnum]
and be iterated with a For Each
loop... but you can't have that functionality through an interface.
What's nice about ICollection
is that it abstracts away the notion of something that can act as a collection, enabling client code to leverage polymorphism and work with a FooCollection
or a BarCollection
seamlessly, or even work with a Queue
or a Stack
custom collection that would implement the same interface. But here we're looking at a Cars
collection, and if our client code is written against ICollection
then we lose everything that's useful about the custom collection (e.g. filtering capabilities), and might as well be working with some VBA.Collection
instance.
But the clsCars class is not only responsible for storing clsCar objects
See, with an ICollection
interface you're forced to have this:
Public Sub Add(ByRef Item as Object)
End Sub
By the way, that should be ByVal
, not ByRef
. Anyway, the problem with that is that you can't legally have this:
Private Sub ICollection_Add(ByRef Item as clsCar)
' Actual implementation...
End Sub
Because the signature mismatches that of the interface: Item
must be Object
, otherwise the interface contract isn't fulfilled and the code can't compile.
I'd just ditch the ICollection
interface and make a Cars
collection that requires Car
items to be added.
That would instantly shrink the Cars
class by half, and enable goodies such as these:
'@DefaultMember
Public Property Get Item(ByVal index As Variant) As Object
Set Item = internal.Item(index)
End Property
'@Enumerator
Public Property Get NewEnum() As IUnknown
Set NewEnum = internal.[_NewEnum]
End Property
If you aren't using Rubberduck, you might not know that these special @Comments
actually control hidden member attributes. The @DefaultMember
annotation makes these two statements equivalent:
Set theCar = allCars.Item("foo")
Set theCar = allCars("foo")
And the @Enumerator
annotation makes this code legal:
For Each theCar In allCars
Debug.Print theCar.Model
Next
By convention, the Item
property if a collection class is that class' default member.
I would have made Count
and Item
members be Property Get
procedures, not Function
. The reason VBA.Collection
has them as Function
procedures is historical; Count
as a method implies much more work going on than what's actually happening, and Item
simply makes complete sense as a default property.
As for the filtering, consider taking inspiration from .NET here - now there's a legit case for polymorphism!
'@Interface IPredicate
Option Explicit
Public Function IsTrue(ByVal obj As Object, ByVal value As Variant) As Boolean
End Function
Now you can have a MatchesManufacturerPredicate
that might look like this:
Option Explicit
Implements IPredicate
Private Function IsTrue(ByVal obj As Object, ByVal value As Variant) As Boolean
If Not TypeOf obj Is Car Then Error.InvalidArgumentException
IsTrue = (obj.Manufacturer = value)
End Function
Then the Cars
collection can have a FilterBy(ByVal predicate As IPredicate)
method that simply runs the collection through the encapsulated function!
Set toyotas = allCars.FilterBy(New MatchesManufacturerPredicate, "Toyota")
Set fords = allCars.FilterBy(New MatchesManufacturerPredicate, "Ford")
Set p911s = allCars.FilterBy(New MatchesModelPredicate, "911")
Set oldCars = allCars.FilterBy(New LessThanYearPredicate, 2009)
With a single FilterBy
method on the collection, you can now have infinite filtering possibilities, as long as you're willing to encapsulate the filtering function into its own class.
-
\$\begingroup\$ Hey. Thanks for you input, but I can't get this code to run. Should I create a new post here, or should I provide code somewhere else? \$\endgroup\$FlameHorizon– FlameHorizon2019年02月27日 08:59:01 +00:00Commented Feb 27, 2019 at 8:59
-
\$\begingroup\$ Never mind, I managed to fix my own problems by myself :). I like your view on this problem. Thanks for tips regarding filtering! I might follow up regarding this topic in the future. Thanks for your time! \$\endgroup\$FlameHorizon– FlameHorizon2019年02月27日 09:19:57 +00:00Commented Feb 27, 2019 at 9:19
Explore related questions
See similar questions with these tags.
cls
-prefix in the name of any class module hurts my eyes much harder than any English mistakes (is that "sudo" meant to be "pseudo"?) ;-) \$\endgroup\$...actual implementation...
into the post; it's hard to review a custom collection class when all that's there is a wireframe view of it. Same for...stuff...
\$\endgroup\$