Option Explicit
 
Private c   As Class2
 
' callback von Class2
' In einem Code Modul würde CB so aussehen:
'
' Public Function CDB(ByVal this As Object,
'        ByVal dummy1 As Long,
'        ByVal dummy2 As Long,
'        pOut As Long) As Long
'     ...
' End Function
'
' 2 Dummy Argumente, weil CallWindowProc
' 4 Parameter auf den Stack legt.
'
' CB MUSS DIE ERSTE FUNKTION IN DER KLASSE SEIN!
Public Function CB(ByVal dummy1 As Long, ByVal dummy2 As Long) As Long
    Debug.Print "Class 1: Class 2 zerstört"
End Function
 
Private Sub Class_Initialize()
    Debug.Print "Class 1 initialisiert"
 
    Set c = New Class2
 
    ' pointer auf diese Klasse für callback übergeben
    c.TerminateCBObj = ObjPtr(Me)
End Sub
 
Private Sub Class_Terminate()
    Debug.Print "Class 1 zerstört"
End Sub

Option Explicit
 
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" ( _
  pDst As Any, _
  pSrc As Any, _
  ByVal ByteLen As Long _
)
 
Private Declare Function CallWindowProc Lib "user32.dll" _
Alias "CallWindowProcA" ( _
    ByVal lpPrevWndFunc As Long, _
    ByVal hWnd As Long, _
    ByVal msg As Long, _
    ByVal WParam As Long, _
    ByVal lParam As Long _
) As Long
 
Private lngObject   As Long
 
Public Property Let TerminateCBObj(ByVal lng As Long)
    lngObject = lng
End Property
 
Private Sub Class_Initialize()
    Debug.Print "Class 2 initialisiert"
End Sub
 
Private Sub Class_Terminate()
    SendMsg
    Debug.Print "Class 2 zerstört"
End Sub
 
Private Sub SendMsg()
 
    Dim lngVTable   As Long
    Dim lngOffset   As Long
    Dim lngAddr     As Long
    Dim lngRet      As Long
    Dim hResult     As Long
 
    ' erste Funktion von übergebenem Klassenpointer
    ' über VTable herausfinden
    CopyMemory lngVTable, ByVal lngObject, 4
    lngOffset = lngVTable + &H1C
    CopyMemory lngAddr, ByVal lngOffset, 4
 
    ' Funktion aufrufen
    ' Param 1:    Object Pointer
    ' Param 2, 3: Dummy Argumente
    ' Param 4:    Rückgabewert
    hResult = CallWindowProc(lngAddr, _
                             lngObject, _
                             0, 0, _
                             VarPtr(lngRet))
 
End Sub

http://rm_code.dl.am