3

以下代码为集合中的每个元素创建循环引用。例程中的代码是否UserForm_Terminate足以破坏关系以释放内存？或者是否需要使用指针和弱引用？

如果是/不是，测试对象是否已释放的最佳方法是什么？

用户表单代码：

Option Explicit
Implements IBtnClick

Dim coll As Collection

Private Sub UserForm_Initialize()
Dim x As Long
Dim e As CBtnEvents

Set coll = New Collection

For x = 1 To 5
    Set e = New CBtnEvents
    Set e.btn = Me.Controls.Add("Forms.CommandButton.1")
    e.ID = x
    e.Register Me
    With e.btn
        .Height = 30
        .Width = 30
        .Top = 10
        .Left = .Width * x
    End With
    coll.Add e
Next x

End Sub

Private Sub UserForm_Terminate()
Dim itm

For Each itm In coll
    msgbox itm.ID
    itm.Unregister
Next itm

End Sub

Private Sub IBtnClick_click(ID As Long)
    MsgBox ID
End Sub

IBtn点击代码：

    Public Sub click(ID As Long)

    End Sub

CBtnEvents 代码：

    Private WithEvents p_btn As MSForms.CommandButton
    Private p_ID As Long
    Private click As IBtnClick

    Public Property Set btn(value As MSForms.CommandButton)
        Set p_btn = value
    End Property

    Public Property Get btn() As MSForms.CommandButton
        Set btn = p_btn
    End Property

    Public Sub Register(value As IBtnClick)
        Set click = value
    End Sub

    Public Sub Unregister()
        Set click = Nothing
    End Sub

    Private Sub p_btn_Click()
        click.click p_ID
    End Sub

    Public Property Get ID() As Long
        ID = p_ID
    End Property

    Public Property Let ID(ByVal lID As Long)
        p_ID = lID
    End Property

    Private Sub Class_Terminate()
        MsgBox p_ID
    End Sub

我已经包含了 VB6 标签，因为我认为这个问题同样适用，但我使用的是 Excel VBA。

4

1 回答 1

3

这就是我们（手动）保存实例簿记集合的方式：

在每个类/表单/控件中，我们放置这样的东西

Option Explicit
DefObj A-Z
Private Const MODULE_NAME As String = "cTransStub"

'=========================================================================
' Constants and member variables
'=========================================================================

' Consts here

' Vars here
#If DebugMode Then
    Private m_sDebugID          As String
#End If

' Props here

' Methods here

'=========================================================================
' Base class events
'=========================================================================

#If DebugMode Then
    Private Sub Class_Initialize()
        DebugInstanceInit MODULE_NAME, m_sDebugID, Me
    End Sub

    Private Sub Class_Terminate()
        DebugInstanceTerm MODULE_NAME, m_sDebugID
    End Sub
#End If

DebugInstanceInit/Term填充DebugIDs集合的辅助 subs 的示例实现：

Public Sub DebugInstanceInit(sModuleName As String, sDebugID As String, oObj As Object)
    Dim sCount          As String
    Dim lObjPtr         As Long
    Dim sObjCtx         As String

    On Error Resume Next
    sDebugID = sDebugID & GetDebugID()
    If DebugIDs Is Nothing Then
    Else
        ...
        lObjPtr = ObjPtr(oObj)  
        DebugIDs.Add sDebugID & " " & LIB_NAME & "." & sModuleName & "|&H" & Hex(lObjPtr) & "|" & Format$(time, "hh:mm:ss") & "|" & sObjCtx & "|", "#" & sDebugID
    End If
    ...
    If Not DebugConsole Is Nothing Then
        DebugConsole.RefreshConsole
    End If
    On Error GoTo 0
End Sub

Public Sub DebugInstanceTerm(sModuleName As String, sDebugID As String)
    On Error Resume Next
    If DebugIDs Is Nothing Then
    Else
        DebugIDs.Remove "#" & sDebugID
    End If
    ...
    If Not DebugIDs Is Nothing Then
        If DebugIDs.Count = 0 Then
            Debug.Print "DebugIDs collection is empty"; Timer
        End If
    End If
    If Not DebugConsole Is Nothing Then
        DebugConsole.RefreshConsole
    End If
    On Error GoTo 0
End Sub

在程序终止时，我们会警告DebugIDs收集中的任何对象泄漏。

于 2012-10-30T13:03:33.557 回答