How can a VBA object instance tell if it is the default instance?

Viewed 310

This doesn't work:


clsTestDefaultInstance

Dim HowAmIInitialised As Integer

Private Sub Class_Initialize()
HowAmIInitialised = 99
End Sub

Public Sub CallMe()
  Debug.Print "HowAmIInitialised=" & HowAmIInitialised
End Sub

i.e clsTestDefaultInstance.CallMe() outputs HowAmIInitialised=99 because Class_Initialize() is called even for the default instance.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsTestDefaultInstance"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database
Option Explicit

' test how class instance can tell if it is default
'clsTestDefaultInstance

Dim HowAmIInitialised As Integer

Private Sub Class_Initialize()
  HowAmIInitialised = HowAmIInitialised + 1
End Sub

Public Sub CallMe()
  Debug.Print "HowAmIInitialised=" & HowAmIInitialised
End Sub
2 Answers

This is really, really simple... just compare the object pointer of the instance to the object pointer of the default instance:

'TestClass.cls (VB_PredeclaredId = True)
Option Explicit

Public Property Get IsDefaultInstance() As Boolean
    IsDefaultInstance = ObjPtr(TestClass) = ObjPtr(Me)
End Property

Testing code shows that it works just fine:

Private Sub TestDefaultInstance()
    Dim foo(9) As TestClass

    Dim idx As Long
    For idx = LBound(foo) To UBound(foo)
        If idx = 5 Then
            Set foo(idx) = TestClass
        Else
            Set foo(idx) = New TestClass
        End If
    Next

    For idx = LBound(foo) To UBound(foo)
        Debug.Print idx & foo(idx).IsDefaultInstance
    Next
End Sub

With that said, note that this comes with a couple caveats:

  • It pretty much guarantees that the default instance will be reinstantiated if you check to see if any instance is the default instance, because as you probably know, simply referencing the default instance will new it back up if it isn't already instantiated.
  • The default instance can change if you Unload it (for UserForm's) or set it to Nothing and then cause it to auto-instantiate again. It's best to think of VB_PredeclaredId as kind of like a contract that you will always get an instance back if you use the class name directly. That contract does not guarantee that it will always be the same one. Adding the following code to the bottom of the TestDefaultInstance procedure above will demonstrate:

    'This doesn't effect anything that stored a reference to it.
    Set TestClass = Nothing
    'Make a call on the default to force it to reinstantiate.
    Debug.Print TestClass.IsDefaultInstance
    'This will now be false.
    Debug.Print foo(5).IsDefaultInstance
    

You can obtain the default instance by using the Class_Initialize and a Static Function within the class to store the default instance.

Using an example extract of my class clsCustomer which has it's VB_PredeclaredId = True

'Note Class_Initialize is called the first time the clsCustomer is accessed 'You can also do things like If Not Me Is clsCustomer for singleton classes i.e cannot create an instance other then default instance

Private Sub Class_Initialize()

If Me Is clsCustomer Then
    GetDefaultInstance
End If

End Sub

Static Function GetDefaultInstance() As clsCustomer

Dim pvtDefaultInstance As clsCustomer
If pvtDefaultInstance Is Nothing Then
    If Not Me Is Nothing Then
       Set pvtDefaultInstance = Me
   End If
End If
Set GetDefaultInstance = pvtDefaultInstance

End Function

In a module to test

Sub TestDefaultInstance()

Dim pvtCustomer As clsCustomer
Debug.Print ObjPtr(clsCustomer.GetDefaultInstance)
Debug.Print ObjPtr(pvtCustomer)
Set pvtCustomer = New clsCustomer
Debug.Print ObjPtr(clsCustomer.GetDefaultInstance)
Debug.Print ObjPtr(pvtCustomer)
Debug.Print IsDefaultInstance(clsCustomer.GetDefaultInstance, pvtCustomer)

End Sub

Public Function IsDefaultInstance(byval defaultObject as Object, byval compareObject as Object) As Boolean

Dim isDefault as Boolean
if defaultObject is compareObject then
  isDefault = True
End if
IsDefaultInstance = isDefault 

End Function

Output

2401988144720 (The default instance)

0 (The pvtCustomer instance not yet set and equal to nothing)

2401988144720 (The default instance)

2401988142160 (The new pvtCustomer instance which isn't the same as the default instance)

False (False returned as the customer default object instance isn't the same as the new pvtCustomer object)

Notes: Output ObjPtr's will vary each run i.e they are memory references and only for example.

Related