拆除循環引用

Question

以下代碼爲集合中的每個元素創建一個循環引用。 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 

IBtnClick代碼：

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。

Answer 1

這是我們如何（手動）保持我們的實例簿記集合：

在每類/表格/控制，我們把這樣的事情

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集合：

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 

在程序終止時，我們警告在泄露任何對象集合。