Question

这不起作用：

clsTestDefaultInstance

Dim HowAmIInitialised As Integer

Private Sub Class_Initialize()
HowAmIInitialised = 99
End Sub

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

即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

Answer 1

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

'TestClass.cls (VB_PredeclaredId = True)
Option Explicit

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

测试代码表明它可以正常工作：

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

话虽如此，请注意，这带有一些警告：

如果您检查实例是否为默认实例，几乎可以保证可以重新实例化默认实例，因为您可能知道，如果尚未实例化默认实例，则只需引用默认实例即可对其进行备份。
默认实例 可以更改 ，如果您Unload（针对UserForm）或将其设置为{{1 }，然后使其再次自动实例化。最好将Nothing视为一种合同，如果直接使用类名，您将总是得到一个实例。该合同不保证其始终相同。将以下代码添加到上述VB_PredeclaredId过程的底部将演示：
```
TestDefaultInstance
```

Answer 2

您可以通过使用Class_Initialize和类中的静态函数来存储默认实例来获取默认实例。

使用我的类clsCustomer的示例摘录，其中有VB_PredeclaredId = True

'注意Class_Initialize在第一次访问clsCustomer时被调用 “对于单例类，您也可以执行“如果不是我是clsCustomer”之类的操作，即无法创建默认实例以外的实例

Private Sub Class_Initialize（）

If Me Is clsCustomer Then
    GetDefaultInstance
End If

结束子

静态函数GetDefaultInstance（）作为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

结束功能

在要测试的模块中

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)

结束子

公共函数IsDefaultInstance（byval defaultObject作为对象，byval compareObject作为对象）作为布尔值

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

结束功能

输出

2401988144720（默认实例）

0（pvtCustomer实例尚未设置且等于空）

2401988144720（默认实例）

2401988142160（新的pvtCustomer实例与默认实例不同）

False（作为客户默认对象实例返回的False与新的pvtCustomer对象不同）

注意：输出ObjPtr每次运行都会不同，即它们是内存引用，仅作为示例。

VBA对象实例如何分辨它是否为默认实例？

2 个答案:

结束功能