Home » excel » vba – Tearing Down Circular References

vba – Tearing Down Circular References

Posted by: admin April 23, 2020 Leave a comment

Questions:

The following code creates a circular reference for each element in the collection. Is the code in the UserForm_Terminate routine sufficient to tear down the relationships to allow the memory to be released? Or is there a requirement to use pointers and weak references?

If so/not what is the best method for testing whether the objects have been released?

Userform Code:

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 Code:

    Public Sub click(ID As Long)

    End Sub

CBtnEvents Code:

    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

I have included the VB6 tag as I think the question applies equally, but I am using Excel VBA.

How to&Answers:

This is how we (manually) keep our instance book-keeping collection:

In every class/form/control we place something like this

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

Sample implementation of helper DebugInstanceInit/Term subs that populate DebugIDs collection:

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

Upon program termination we warn for any object leaking in DebugIDs collection.