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

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タグを含めましたが、ExcelVBAを使用しています。

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

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 に答える