VBA对象实例如何判断它是否是默认实例?

Mar*_*rry 3 vba

这不起作用:


clsTestDefaultInstance

Dim HowAmIInitialised As Integer

Private Sub Class_Initialize()
HowAmIInitialised = 99
End Sub
Run Code Online (Sandbox Code Playgroud)

Public Sub CallMe()
  Debug.Print "HowAmIInitialised=" & HowAmIInitialised
End Sub
Run Code Online (Sandbox Code Playgroud)

clsTestDefaultInstance.CallMe()输出HowAmIInitialised=99因为 Class_Initialize()即使是默认实例也被调用.

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
Run Code Online (Sandbox Code Playgroud)

Com*_*ern 5

这真的非常简单......只需将实例的对象指针与默认实例的对象指针进行比较:

'TestClass.cls (VB_PredeclaredId = True)
Option Explicit

Public Property Get IsDefaultInstance() As Boolean
    IsDefaultInstance = ObjPtr(TestClass) = ObjPtr(Me)
End Property
Run Code Online (Sandbox Code Playgroud)

测试代码显示它工作得很好:

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
Run Code Online (Sandbox Code Playgroud)

话虽如此,请注意这有几点需要注意:

  • 如果您检查是否有任何实例是默认实例,它几乎可以保证默认实例将被重新实例化,因为您可能知道,如果尚未实例化,只需引用默认实例就会重新启动它.
  • 默认情况下可以改变,如果你Unload这(对UserForm的),或者将其设置为Nothing再次,然后导致其自动实例化.最好将其VB_PredeclaredId视为一种合约,如果直接使用类名,您将始终获得实例.该合同并不保证它永远是同一个合同.将以下代码添加到上述TestDefaultInstance过程的底部将演示:

    '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
    
    Run Code Online (Sandbox Code Playgroud)