Polymorphic Behavior in VB6 - oop

I recently noticed the CallByName keyword in VB6.
Since this takes a object, procedure name, "call type" and arguments array, can this be used to "fake" some types of polymorphic behavior?
I can make 2 classes, class A and B, each with the same method Foo, and do:
Dim list As New Collection
Dim instanceA As New ClassA
Dim instanceB As New ClassB
Dim current As Object
Call list.Add(instanceA)
Call list.Add(instanceB)
For Each current in list
Call CallByName(current, "methodName", vbMethod)
Next
Anyone done this before? Problems? Horrible idea or genius idea? Implications? Unintended consequences?

Why fake polymorphism? VB6 has real polymorphism in the form of interfaces:
' Interface1.cls '
Sub Foo()
End Sub
' --------------------------------------------- '
' Class1.cls '
Implements Interface1
Private Sub Interface1_Foo()
? "Hello from class 1"
End Sub
' --------------------------------------------- '
' Class2.cls '
Implements Interface1
Private Sub Interface1_Foo()
? "Hello from class 2"
End Sub
' --------------------------------------------- '
' Module1.mod '
Dim x As Interface1
Set x = New Class1
Call x.Foo()
Set x = New Class2
Call x.Foo()

Although I agree with Mr. unicorn, I can't help but point out that CallByName is also unnecessary (in this case) because you can call the method using the standard method syntax and it will result in a late-bound (i.e. not resolved at compile-time) call:
...
For Each current In list
Call current.methodName
Next
The real use of CallByName is to reference method names/properties where the name comes from a (possibly calculated) string value...an absolute abomination, in my opinion.

If you are in a situation where you inherited a huge project with not a single interface in it (it sounds like you did), then CallByName is an awesome tool to fake polymorphism. I use it all the time - never had any issues whatsoever.

Related

VBA inheritance

I heard a lot of that VBA is lacking inheritance. I did a little workaround and now it seems to me that it is exactly what inheritance does. I'm far from pro =) and may be missing something. So I would really appreciate your thoughts about possible downsides.
I was very surprised when found that you still can make a full realization of a function in an interface class (not only a signature), which led me to the following below. I saw that some people did similar with help of composition, but they used only a signature in the interface.
IBird - class
Public Sub SayFromInterface()
Debug.Print "Tweet from IBird"
End Sub
Public Sub SayFromInstance()
End Sub
Crow - class
Implements IBird
Private pBird As IBird
Private Sub Class_Initialize()
Set pBird = New IBird
End Sub
'let you use already implemented code from "abstract class", to avoid
'duplicating your code, which is the main point of inheritance
'in my opinion
Public Sub IBird_SayFromInterface()
pBird.SayFromInterface
End Sub
'you can override the IBird function (common use)
Public Sub IBird_SayFromInstance()
Debug.Print "Tweet from Crow"
End Sub
Test - module
Sub testIBird()
Dim Bird As IBird
Set Bird = New Crow
Bird.SayFromInterface
Bird.SayFromInstance
Debug.Print TypeName(Bird)
Debug.Print TypeOf Bird Is IBird
End Sub
Output:
Tweet from IBird
Tweet from Crow
Crow
True
That's composition, not inheritance - and yes, with composition you can essentially emulate inheritance. And if the class implements the interface of the encapsulated object, then things start looking like some kind of a decorator pattern.
Except you wouldn't be having any implementation code in IBird. An interface should be purely abstract. Making a New instance of what's supposed to be an interface, makes the class no longer be an interface: now it's just another class exposing a default interface that any other class can implement, and the I prefix becomes rather confusing:
Set pBird = New IBird
It's rather weird that the client code now needs to wonder whether they want that bird to chirp FromInstance or FromInterface - these are very "meta" identifiers that make things not work like inheritance.
If we had a Crow : Bird where Bird had this implementation for IBird.Chirp:
public virtual string Chirp() => "Chirp!";
...and then Crow had this:
public override string Chirp() => "Craaaw!";
Then which method is invoked depends on what the runtime type is - this should feel pretty obvious:
IBird bird1 = new Bird();
bird1.Chirp(); // "Chirp!"
IBird bird2 = new Crow();
bird2.Chirp(); // "Craaaw!"
However picture a method that receives an IBird parameter:
public void DoSomething(IBird bird)
{
Debug.Print(bird.Chirp());
}
If bird is a Bird, it prints "Chirp!"; if bird is a Crow, it prints "Craaaw!": the method that gets to run, is the most derived override, which isn't necessarily defined on the most derived type.
Inheritance would allow a GiantCrow : Crow to inherit the Chirp method from Crow and not necessarily override it. And that is what you can't simulate with VBA classes: you are forced to write the equivalent of...
public override string Chirp() => base.Chirp();
...which is technically redundant, and gets very repetitive if you have to do it every time just to get the "base" members visible on your default interface.
Instead of inheriting base members, we actually wrap calls to the encapsulated object. The decorator pattern does exactly that, and gives you a non-intrusive way of extending a VBA class or interface.
A decorator implements the interface it's extending, and encapsulates a private instance of that type. So basically with a decorator the "crow inheritance hierarchy" setup looks like this:
Dim bird As IBird
Set bird = Crow.Create(New BaseBird)
A perhaps more suitable decorator pattern example might be:
Dim repository As IRepository
Set repository = LoggingRepository.Create(BirdRepository.Create(connectionString), New DebugLogger)
Where a BirdRepository is responsible for abstracting the database operations relating to some Birds table (BirdRepository implements IRepository), and where LoggingRepository is a decorator that also implements IRepository, but also wraps an IRepository instance (in this case a BirdRepository) to add its own functionality - something that might look like this:
'#PredeclaredId
Implements IRepository
Private loggerInternal As ILogger
Private wrappedInternal As IRepository
Public Function Create(ByVal internal As IRepository, ByVal logger As ILogger) As IRepository
Dim result As LoggingRepository
Set result.Wrapped = internal
Set result.Log = logger
Set Create = result
End Function
Public Property Get Wrapped() As IRepository
Set Wrapped = wrappedInternal
End Property
Public Property Set Wrapped(ByVal value As IRepository)
If Not wrappedInternal Is Nothing Then Err.Raise 5, TypeName(Me), "Instance is already initialized."
Set wrappedInternal = value
End Property
Public Property Get Log() As ILogger
Set Log = loggerInternal
End Property
Public Property Set Log(ByVal value As ILogger)
If Not loggerInternal Is Nothing Then Err.Raise 5, TypeName(Me), "Instance is already initialized."
Set loggerInternal = value
End Property
Private Function IRepository_SelectAll() As Object
Log.Info "Starting IRepository.SelectAll"
Dim t As Double
t = Timer
Set IRepository_SelectAll = wrappedInternal.SelectAll
Log.Info "IRepository.SelectAll completed in " & Timer - t & " seconds."
End Function
Private Sub IRepository_Delete(ByVal id As Long)
Log.Info "Starting IRepository.Delete(" & id & ")"
Dim t As Double
t = Timer
wrappedInternal.Delete id
Log.Info "IRepository.Delete completed in " & Timer - t & " seconds."
End Sub
Private Sub IRepository_Save(ByVal entity As Object)
'...
wrappedInternal.Save entity
'...
End Sub
'...
A method that is given a IRepository object cannot (and absolutely should not) know whether it's given a plain BirdRepository, a LoggingRepository wrapping a BirdRepository, or a FakeRepository that encapsulates a Collection instead of access to a database table - and this polymorphism is the entire point.
It's one way to extend a type without using inheritance, that VBA can absolutely leverage without bastardizing the pattern too much. But it's not inheritance.

Vb6 Deep Count the number of properties in a UDT Object [duplicate]

I have a feeling the answer to this is going to be "not possible", but I'll give it a shot...
I am in the unenviable position of modifying a legacy VB6 app with some enhancements. Converting to a smarter language isn't an option.
The app relies on a large collection of user defined types to move data around. I would like to define a common function that can take a reference to any of these types and extract the data contained.
In pseudo code, here's what I'm looking for:
Public Sub PrintUDT ( vData As Variant )
for each vDataMember in vData
print vDataMember.Name & ": " & vDataMember.value
next vDataMember
End Sub
It seems like this info needs to be available to COM somewhere... Any VB6 gurus out there care to take a shot?
Thanks,
Dan
Contrary to what others have said, it IS possible to get run-time type information for UDT's in VB6 (although it is not a built-in language feature). Microsoft's TypeLib Information Object Library (tlbinf32.dll) allows you to programmatically inspect COM type information at run-time. You should already have this component if you have Visual Studio installed: to add it to an existing VB6 project, go to Project->References and check the entry labeled "TypeLib Information." Note that you will have to distribute and register tlbinf32.dll in your application's setup program.
You can inspect UDT instances using the TypeLib Information component at run-time, as long as your UDT's are declared Public and are defined within a Public class. This is necessary in order to make VB6 generate COM-compatible type information for your UDT's (which can then be enumerated with various classes in the TypeLib Information component). The easiest way to meet this requirement would be to put all your UDT's into a public UserTypes class that will be compiled into an ActiveX DLL or ActiveX EXE.
Summary of a working example
This example contains three parts:
Part 1: Creating an ActiveX DLL project that will contain all the public UDT declarations
Part 2: Creating an example PrintUDT method to demonstrate how you can enumerate the fields of a UDT instance
Part 3: Creating a custom iterator class that allows you easily iterate through the fields of any public UDT and get field names and values.
The working example
Part 1: The ActiveX DLL
As I already mentioned, you need to make your UDT's public-accessible in order to enumerate them using the TypeLib Information component. The only way to accomplish this is to put your UDT's into a public class inside an ActiveX DLL or ActiveX EXE project. Other projects in your application that need to access your UDT's will then reference this new component.
To follow along with this example, start by creating a new ActiveX DLL project and name it UDTLibrary.
Next, rename the Class1 class module (this is added by default by the IDE) to UserTypes and add two user-defined types to the class, Person and Animal:
' UserTypes.cls '
Option Explicit
Public Type Person
FirstName As String
LastName As String
BirthDate As Date
End Type
Public Type Animal
Genus As String
Species As String
NumberOfLegs As Long
End Type
Listing 1: UserTypes.cls acts as a container for our UDT's
Next, change the Instancing property for the UserTypes class to "2-PublicNotCreatable". There is no reason for anyone to instantiate the UserTypes class directly, because it's simply acting as a public container for our UDT's.
Finally, make sure the Project Startup Object (under Project->Properties) is set to to "(None)" and compile the project. You should now have a new file called UDTLibrary.dll.
Part 2: Enumerating UDT Type Information
Now it's time to demonstrate how we can use TypeLib Object Library to implement a PrintUDT method.
First, start by creating a new Standard EXE project and call it whatever you like. Add a reference to the file UDTLibrary.dll that was created in Part 1. Since I just want to demonstrate how this works, we will use the Immediate window to test the code we will write.
Create a new Module, name it UDTUtils and add the following code to it:
'UDTUtils.bas'
Option Explicit
Public Sub PrintUDT(ByVal someUDT As Variant)
' Make sure we have a UDT and not something else... '
If VarType(someUDT) <> vbUserDefinedType Then
Err.Raise 5, , "Parameter passed to PrintUDT is not an instance of a user-defined type."
End If
' Get the type information for the UDT '
' (in COM parlance, a VB6 UDT is also known as VT_RECORD, Record, or struct...) '
Dim ri As RecordInfo
Set ri = TLI.TypeInfoFromRecordVariant(someUDT)
'If something went wrong, ri will be Nothing'
If ri Is Nothing Then
Err.Raise 5, , "Error retrieving RecordInfo for type '" & TypeName(someUDT) & "'"
Else
' Iterate through each field (member) of the UDT '
' and print the out the field name and value '
Dim member As MemberInfo
For Each member In ri.Members
'TLI.RecordField allows us to get/set UDT fields: '
' '
' * to get a fied: myVar = TLI.RecordField(someUDT, fieldName) '
' * to set a field TLI.RecordField(someUDT, fieldName) = newValue '
' '
Dim memberVal As Variant
memberVal = TLI.RecordField(someUDT, member.Name)
Debug.Print member.Name & " : " & memberVal
Next
End If
End Sub
Public Sub TestPrintUDT()
'Create a person instance and print it out...'
Dim p As Person
p.FirstName = "John"
p.LastName = "Doe"
p.BirthDate = #1/1/1950#
PrintUDT p
'Create an animal instance and print it out...'
Dim a As Animal
a.Genus = "Canus"
a.Species = "Familiaris"
a.NumberOfLegs = 4
PrintUDT a
End Sub
Listing 2: An example PrintUDT method and a simple test method
Part 3: Making it Object-Oriented
The above examples provide a "quick and dirty" demonstration of how to use the TypeLib Information Object Library to enumerate the fields of a UDT. In a real-world scenario, I would probably create a UDTMemberIterator class that would allow you to more easily iterate through the fields of UDT, along with a utility function in a module that creates a UDTMemberIterator for a given UDT instance. This would allow you to do something like the following in your code, which is much closer to the pseudo-code you posted in your question:
Dim member As UDTMember 'UDTMember wraps a TLI.MemberInfo instance'
For Each member In UDTMemberIteratorFor(someUDT)
Debug.Print member.Name & " : " & member.Value
Next
It's actually not too hard to do this, and we can re-use most of the code from the PrintUDT routine created in Part 2.
First, create a new ActiveX project and name it UDTTypeInformation or something similar.
Next, make sure that the Startup Object for the new project is set to "(None)".
The first thing to do is to create a simple wrapper class that will hide the details of the TLI.MemberInfo class from calling code and make it easy to get a UDT's field's name and value. I called this class UDTMember. The Instancing property for this class should be PublicNotCreatable.
'UDTMember.cls'
Option Explicit
Private m_value As Variant
Private m_name As String
Public Property Get Value() As Variant
Value = m_value
End Property
'Declared Friend because calling code should not be able to modify the value'
Friend Property Let Value(rhs As Variant)
m_value = rhs
End Property
Public Property Get Name() As String
Name = m_name
End Property
'Declared Friend because calling code should not be able to modify the value'
Friend Property Let Name(ByVal rhs As String)
m_name = rhs
End Property
Listing 3: The UDTMember wrapper class
Now we need to create an iterator class, UDTMemberIterator, that will allow us to use VB's For Each...In syntax to iterate the fields of a UDT instance. The Instancing property for this class should be set to PublicNotCreatable (we will define a utility method later that will create instances on behalf of calling code).
EDIT: (2/15/09) I've cleaned the code up a bit more.
'UDTMemberIterator.cls'
Option Explicit
Private m_members As Collection ' Collection of UDTMember objects '
' Meant to be called only by Utils.UDTMemberIteratorFor '
' '
' Sets up the iterator by reading the type info for '
' the passed-in UDT instance and wrapping the fields in '
' UDTMember objects '
Friend Sub Initialize(ByVal someUDT As Variant)
Set m_members = GetWrappedMembersForUDT(someUDT)
End Sub
Public Function Count() As Long
Count = m_members.Count
End Function
' This is the default method for this class [See Tools->Procedure Attributes] '
' '
Public Function Item(Index As Variant) As UDTMember
Set Item = GetWrappedUDTMember(m_members.Item(Index))
End Function
' This function returns the enumerator for this '
' collection in order to support For...Each syntax. '
' Its procedure ID is (-4) and marked "Hidden" [See Tools->Procedure Attributes] '
' '
Public Function NewEnum() As stdole.IUnknown
Set NewEnum = m_members.[_NewEnum]
End Function
' Returns a collection of UDTMember objects, where each element '
' holds the name and current value of one field from the passed-in UDT '
' '
Private Function GetWrappedMembersForUDT(ByVal someUDT As Variant) As Collection
Dim collWrappedMembers As New Collection
Dim ri As RecordInfo
Dim member As MemberInfo
Dim memberVal As Variant
Dim wrappedMember As UDTMember
' Try to get type information for the UDT... '
If VarType(someUDT) <> vbUserDefinedType Then
Fail "Parameter passed to GetWrappedMembersForUDT is not an instance of a user-defined type."
End If
Set ri = tli.TypeInfoFromRecordVariant(someUDT)
If ri Is Nothing Then
Fail "Error retrieving RecordInfo for type '" & TypeName(someUDT) & "'"
End If
' Wrap each UDT member in a UDTMember object... '
For Each member In ri.Members
Set wrappedMember = CreateWrappedUDTMember(someUDT, member)
collWrappedMembers.Add wrappedMember, member.Name
Next
Set GetWrappedMembersForUDT = collWrappedMembers
End Function
' Creates a UDTMember instance from a UDT instance and a MemberInfo object '
' '
Private Function CreateWrappedUDTMember(ByVal someUDT As Variant, ByVal member As MemberInfo) As UDTMember
Dim wrappedMember As UDTMember
Set wrappedMember = New UDTMember
With wrappedMember
.Name = member.Name
.Value = tli.RecordField(someUDT, member.Name)
End With
Set CreateWrappedUDTMember = wrappedMember
End Function
' Just a convenience method
'
Private Function Fail(ByVal message As String)
Err.Raise 5, TypeName(Me), message
End Function
Listing 4: The UDTMemberIterator class.
Note that in order to make this class iterable so that For Each can be used with it, you will have to set certain Procedure Attributes on the Item and _NewEnum methods (as noted in the code comments). You can change the Procedure Attributes from the Tools Menu (Tools->Procedure Attributes).
Finally, we need a utility function (UDTMemberIteratorFor in the very first code example in this section) that will create a UDTMemberIterator for a UDT instance, which we can then iterate with For Each. Create a new module called Utils and add the following code:
'Utils.bas'
Option Explicit
' Returns a UDTMemberIterator for the given UDT '
' '
' Example Usage: '
' '
' Dim member As UDTMember '
' '
' For Each member In UDTMemberIteratorFor(someUDT) '
' Debug.Print member.Name & ":" & member.Value '
' Next '
Public Function UDTMemberIteratorFor(ByVal udt As Variant) As UDTMemberIterator
Dim iterator As New UDTMemberIterator
iterator.Initialize udt
Set UDTMemberIteratorFor = iterator
End Function
Listing 5: The UDTMemberIteratorFor utility function.
Finally, compile the project and create a new project to test it out.
In your test projet, add a reference to the newly-created UDTTypeInformation.dll and the UDTLibrary.dll created in Part 1 and try out the following code in a new module:
'Module1.bas'
Option Explicit
Public Sub TestUDTMemberIterator()
Dim member As UDTMember
Dim p As Person
p.FirstName = "John"
p.LastName = "Doe"
p.BirthDate = #1/1/1950#
For Each member In UDTMemberIteratorFor(p)
Debug.Print member.Name & " : " & member.Value
Next
Dim a As Animal
a.Genus = "Canus"
a.Species = "Canine"
a.NumberOfLegs = 4
For Each member In UDTMemberIteratorFor(a)
Debug.Print member.Name & " : " & member.Value
Next
End Sub
Listing 6: Testing out the UDTMemberIterator class.
If you change all your Types to Classes. You have options. The big pitfall of changing from a type to a class is that you have to use the new keyworld. Every time there a declaration of a type variable add new.
Then you can use the variant keyword or CallByName. VB6 doesn't have anytype of reflection but you can make lists of valid fields and test to see if they are present for example
The Class Test has the following
Public Key As String
Public Data As String
You can then do the following
Private Sub Command1_Click()
Dim T As New Test 'This is NOT A MISTAKE read on as to why I did this.
T.Key = "Key"
T.Data = "One"
DoTest T
End Sub
Private Sub DoTest(V As Variant)
On Error Resume Next
Print V.Key
Print V.Data
Print V.DoesNotExist
If Err.Number = 438 Then Print "Does Not Exist"
Print CallByName(V, "Key", VbGet)
Print CallByName(V, "Data", VbGet)
Print CallByName(V, "DoesNotExist", VbGet)
If Err.Number = 438 Then Print "Does Not Exist"
End Sub
If you attempt to use a field that doesn't exist then error 438 will be raised. CallByName allows you to use strings to call the field and methods of a class.
What VB6 does when you declare Dim as New is quite interesting and will greatly minimize bugs in this conversion. You see this
Dim T as New Test
is not treated exactly the same as
Dim T as Test
Set T = new Test
For example this will work
Dim T as New Test
T.Key = "A Key"
Set T = Nothing
T.Key = "A New Key"
This will give a error
Dim T as Test
Set T = New Test
T.Key = "A Key"
Set T = Nothing
T.Key = "A New Key"
The reason for this is that in the first example VB6 flags T so that anytime a member is accessed it check whether the T is nothing. If it is it will automatically create a new instance of the Test Class and then assign the variable.
In the second example VB doesn't add this behavior.
In most project we rigorously make sure we go Dim T as Test, Set T = New Test. But in your case since you want to convert Types into Classes with the least amount of side effects using Dim T as New Test is the way to go. This is because the Dim as New cause the variable to mimic the way types works more closely.
#Dan,
It looks like your trying to use RTTI of a UDT. I don't think you can really get that information without knowing about the UDT before run-time.
To get you started try:
Understanding UDTs
Because of not having this reflection capability. I would create my own RTTI to my UDTs.
To give you a baseline. Try this:
Type test
RTTI as String
a as Long
b as Long
c as Long
d as Integer
end type
You can write a utility that will open every source file and add The RTTI with the name of the type to the UDT. Probably would be better to put all the UDTs in a common file.
The RTTI would be something like this:
"String:Long:Long:Long:Integer"
Using the memory of the UDT you can extract the values.

Restrict type in a Collection inside a class module

I have a collection inside a class module. I'd like to restrict the object type that is "addable" to this collection, i.e. collection should only ever accept objects of one given type and nothing else.
Is there any way to enforce the type of objects added to a collection?
From what I can tell, there is no built-in way to do this. Is the solution then to make this collection private, and build wrapper functions for the methods usually accessible for Collections, i.e. Add, Remove, Item, and Count?
I kinda hate having to write 3 wrapper functions that add no functionality, just to be able to add some type enforcement to the Add method. But if that's the only way, then that's the only way.
There is no way to avoid wrapper functions. That's just inherent in the "specialization through containment/delegation" model that VBA uses.
You can build a "custom collection class", though. You can even make it iterable with For...Each, but that requires leaving the VBA IDE and editing source files directly.
First, see the "Creating Your Own Collection Classes" section of the old Visual Basic 6.0 Programmer's Guide:
http://msdn.microsoft.com/en-us/library/aa262340(v=VS.60).aspx
There is also an answer here on stackoverflow that describes the same thing:
vb6 equivalent to list<someclass>
However, those are written for VB6, not VBA. In VBA you can't do the "procedure attributes" part in the IDE. You have to export the class module as text and add it in with a text editor. Dick Kusleika's website Daily Dose of Excel (Dick is a regular stackoverflow contributer as you probably know) has a post from Rob van Gelder showing how to do this:
http://www.dailydoseofexcel.com/archives/2010/07/04/custom-collection-class/
In your case, going to all that trouble - each "custom collection" class needs its own module - might not be worth it. (If you only have one use for this and it is buried in another class, you might find that you don't want to expose all of the functionality of Collection anyway.)
This is what I did. I liked Rob van Gelder's example, as pointed to by #jtolle, but why should I be content with making a "custom collection class" that will only accept one specific object type (e.g. People), forever? As #jtolle points out, this is super annoying.
Instead, I generalized the idea and made a new class called UniformCollection that can contain any data type -- as long as all items are of the same type in any given instance of UniformCollection.
I added a private Variant that is a placeholder for the data type that a given instance of UniformCollection can contain.
Private mvarPrototype As Variant
After making an instance of UniformCollection and before using it, it must be initialized by specifying which data type it will contain.
Public Sub Initialize(Prototype As Variant)
If VarType(Prototype) = vbEmpty Or VarType(Prototype) = vbNull Then
Err.Raise Number:=ERR__CANT_INITIALIZE, _
Source:=TypeName(Me), _
Description:=ErrorDescription(ERR__CANT_INITIALIZE) & _
TypeName(Prototype)
End If
' Clear anything already in collection.
Set mUniformCollection = New Collection
If VarType(Prototype) = vbObject Or VarType(Prototype) = vbDataObject Then
' It's an object. Need Set.
Set mvarPrototype = Prototype
Else
' It's not an object.
mvarPrototype = Prototype
End If
' Collection will now accept only items of same type as Prototype.
End Sub
The Add method will then only accept new items that are of the same type as Prototype (be it an object or a primitive variable... haven't tested with UDTs yet).
Public Sub Add(NewItem As Variant)
If VarType(mvarPrototype) = vbEmpty Then
Err.Raise Number:=ERR__NOT_INITIALIZED, _
Source:=TypeName(Me), _
Description:=ErrorDescription(ERR__NOT_INITIALIZED)
ElseIf Not TypeName(NewItem) = TypeName(mvarPrototype) Then
Err.Raise Number:=ERR__INVALID_TYPE, _
Source:=TypeName(Me), _
Description:=ErrorDescription(ERR__INVALID_TYPE) & _
TypeName(mvarPrototype) & "."
Else
' Object is of correct type. Accept it.
' Do nothing.
End If
mUniformCollection.Add NewItem
End Sub
The rest is pretty much the same as in the example (plus some error handling). Too bad RvG didn't go the whole way! Even more too bad that Microsoft didn't include this kind of thing as a built-in feature...
I did almost the same code of Jean-François Corbett, but I adapted because for some reason wasn't working.
Option Explicit
Public pParametro As String
Private pColecao As New Collection
Public Sub Inicializar(ByVal parametro As String)
pParametro = parametro
End Sub
Public Sub Add(NewItem As Object)
If TypeName(NewItem) <> pParametro Then
MsgBox "Classe do objeto não é compatível à coleção"
Else
pColecao.Add NewItem
End If
End Sub
Public Property Get Count() As Long
Count = pColecao.Count
End Property
Public Property Get Item(NameOrNumber As Variant) As Variant
Set Item = pColecao(NameOrNumber)
End Property
Sub Remove(NameOrNumber As Variant)
pColecao.Remove NameOrNumber
End Sub
Then, when i want to create an instance from CCollection I make like the code bellow:
Set pFornecedores = New CCollection
pFornecedores.Inicializar ("CEmpresa")
Where CEmpresa is the class type from the object I want
Yes. The solution is to make your collection private and then make public wrapper functions to add, remove, getitem and count etc.
It may seem like hassle to write the additional code but it is a more robust solution to encapsulate the collection like this.

VBA inheritance, analog of super

For example I have class A which implements class B
---class A----
implements B
public sub B_do()
end sub
--class B----
public sub do()
end sub
How can I call do() from A? (super.do()) So, how I can define some common variable for both classes? Now I can inherit only functions, sub and properties...
added: same question http://social.msdn.microsoft.com/Forums/en-US/vbgeneral/thread/5a83d794-3da1-466a-83d3-5d2eb0a054b2
added: It is not possible to share variable across hierarhy of classes. You should implements property (same way as functions).
The usual way to do this in VBA is to have A contain an instance of B as well as having A implement B's interface, and then delegate calls to the B interface of A to the internal B.
This is old stuff, but see the Visual Studio 6.0 Programmer's Guide:
http://msdn.microsoft.com/en-us/library/aa716285(VS.60).aspx
There is a chapter on "The Many (Inter)Faces of Code Reuse" that describes this convention:
http://msdn.microsoft.com/en-us/library/aa240846(v=VS.60).aspx
The way MS describes it is:
In addition to implementing abstract
interfaces, you can reuse your code by
implementing the interface of an
ordinary class, and then selectively
delegating to a hidden instance of the
class.
This means that implementation inheritance requires lots of explicit delegation methods. There's even a chapter subheading: "Doesn't This Get Tedious?". Yet another reason why OOP in VBA is a PITA (TM)...
EDIT THAT WON'T FIT IN A COMMENT:
To answer the question you posed in your comment, well, an A is a B. When you make A implement B's interface, you are essentially saying that you can treat an instance of A as if it is actually of type B. In VBA, the way you do that is by declaring a variable of type B, and then setting it to an instance of A. VBA will know what to do when you call it like a B:
Dim usedAsB as B
Dim anA as A
Set anA = New A
Set usedAsB = anA 'fine since A implements B
usedAsB.something() 'will call B_something() defined in class A
As far as what you see in the debug window, I don't why it appears that way. And as far as forced delegation, I'm not sure what you mean. VBA automatically dispatches calls to the B interface to the right methods in the A class. If you mean automatically generating the code to inherit B's implementation in the manner described above, there's nothing like that I know of for VBA. I think the various "professional" versions of VB6 could do that, but I've never used VB6 so I don't know.
This is the way I have used it a long time to simulate an abstract class through the interface.
'class module: IBase
'We define a base interface
'
Sub go(): End Sub
Sub gogo(): End Sub
Now let's define the other classes, beginning with the abstract class 'B'.
'
'class module: B
'
Implements IBase
'Daughter classes should implement 'go'
'Note that the method is 'Public'
Public Sub go(): End Sub
'Let's agree that every daughter class implements the method
'abstract 'super' that returns the IBase interface
Public Property Get super() As IBase: End Property
'
'The signature of other abstract methods can be stated here
'
'Public Sub goGoChild(): End Sub
'Public Function goGoGoChild2(): End Function
'
'
'Note that the methods are accessible through the IBase interface
'
Private Sub IBase_go()
Debug.Print "B: super.go()"
End Sub
Private Sub IBase_gogo()
Debug.Print "B: super.gogo()"
End Sub
Let's create class 'A' which implements the abstract class 'B'
'
'class module: 'A'
'
'We started implementing the abstract class B
Implements B
'we define a private type 'myType'
Private Type myType
'variable that references an instance of 'B'
objB As B
'variable that references the interface of 'B'
objIB As IBase
End Type
'VBA version of 'this'
Private this As myType
'
'Every class that implements 'B' (abstract class)
'you must initialize in your constructor some variables
'of instance.
'
Private Sub Class_Initialize()
With this
'we create an instance of object B
Set .objB = New B
'the variable 'objIB' refers to the IBase interface, implemented by class B
Set .objIB = .objB
End With
End Sub
'Visible only for those who reference interface B
Private Property Get B_super() As IBase
'returns the methods implemented by 'B', through the interface IBase
Set B_super = this.objIB
End Property
Private Sub B_go()
Debug.Print "A: go()"
End Sub
'==================================================
'Class 'A' local method
Sub localMethod1()
Debug.Print "A: Local method 1"
End Sub
And finally, let's create the 'main' module.
Sub testA()
'reference to class 'A'
Dim objA As A
'reference to interface 'B'
Dim objIA As B
'we create an instance of 'A'
Set objA = New A
'we access the local methods of instance 'A'
objA.localMethod1
'we obtain the reference to interface B (abstract class) implemented by 'A'
Set objIA = objA
'we access the 'go' method, implemented by interface 'B'
objIA.go
'we go to the 'go' method of the super class
objIA.super.go
'we access the 'gogo' method of the super class
objIA.super.gogo
End Sub
And the output, in the verification window, will be:
A: Local method 1
A: go()
B: super.go()
B: super.gogo()
One can pull a trick to mimic inheritance. It works by using the default member property.
If you give your derived class a property called Super whose type is the superclass then make that the default member (by exporting and editing file to include Attribute Item.VB_UserMemId = 0, re-importing) then you can reach the superclass by just a pair of round brackets (which resolves to the default member).
This blog post gives the full details but author (disclosure, me) there uses 'Base' instead of 'Super'
Hopefully that syntax is tight enough for you.
I also point out that this does not expose all the base class's internal guts like C# does. This means my method does not suffer from the fragile base class problem. I.e. my method retains encapsulation making it better IMHO.

Dynamic properties for classes in visual basic

I am a vb.net newbie, so please bear with me. Is it possible to create properties (or attributes) for a class in visual basic (I am using Visual Basic 2005) ? All web searches for metaprogramming led me nowhere. Here is an example to clarify what I mean.
public class GenericProps
public sub new()
' ???
end sub
public sub addProp(byval propname as string)
' ???
end sub
end class
sub main()
dim gp as GenericProps = New GenericProps()
gp.addProp("foo")
gp.foo = "Bar" ' we can assume the type of the property as string for now
console.writeln("New property = " & gp.foo)
end sub
So is it possible to define the function addProp ?
Thanks!
Amit
It's not possible to modify a class at runtime with new properties1. VB.Net is a static language in the sense that it cannot modify it's defined classes at runtime. You can simulate what you're looking for though with a property bag.
Class Foo
Private _map as New Dictionary(Of String, Object)
Public Sub AddProperty(name as String, value as Object)
_map(name) = value
End Sub
Public Function GetProperty(name as String) as Object
return _map(name)
End Function
End Class
It doesn't allow direct access in the form of myFoo.Bar but you can call myFoo.GetProperty("Bar").
1 I believe it may be possible with the profiling APIs but it's likely not what you're looking for.
Came across this wondering the same thing for Visual Basic 2008.
The property bag will do me for now until I can migrate to Visual Basic 2010:
http://blogs.msdn.com/vbteam/archive/2010/01/20/fun-with-dynamic-objects-doug-rothaus.aspx
No - that's not possible. You'd need a Ruby like "method_missing" to handle the unknown .Foo call. I believe C# 4 promises to offer something along these lines.