Content Supported by Sourcelens Consulting
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "TestClass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' >> Best viewed in Full Module view. <<
'
' Storage for debug ID number.
Private mlngDebugID As Long
Implements IDebug
' Private storage for the user-defined
' type (UDT) that gets passed between
' objects. The UDT must be declared
' Public in a standard module (see
' modFriends). (In this example, mDemo
' serves as the storage for both the
' Demo property and the GetDemo/SetDemo
' Function/Sub pair.)
Private mDemo As udtDEMO
' Demo property: The Property Get and Let
' ------------- for the Demo property
' show how property procedures declared
' with the Friend keyword can accept and
' return a UDT.
Friend Property Get Demo() As udtDEMO
Demo = mDemo
End Property
' Note that the argument of the Property
' Let must be ByRef for a UDT.
Friend Property Let Demo(NewDemo As udtDEMO)
mDemo = NewDemo
End Property
' GetDemo and SetDemo show how Friend
' ------------------- functions can
' return UDTs, and how UDTs can be
' arguments of Friend procedures.
Friend Function GetDemo() As udtDEMO
GetDemo = mDemo
End Function
' Note that a UDT argument for a procedure
' must be declared ByRef.
Friend Sub SetDemo(NewDemo As udtDEMO)
mDemo = NewDemo
End Sub
' SetDemoParts is a helper method that
' ------------ fills in the elements
' of the UDT, so there's something to
' pass. In a real program, the elements
' of the UDT might be filled in by code
' in the TestClass object.
Public Sub SetDemoParts(ByVal A As Integer, _
ByVal B As Long, ByVal C As String)
mDemo.intA = A
mDemo.lngB = B
mDemo.strC = C
End Sub
' ShowDemo displays the elements of the
' -------- UDT, so they can be viewed
' after the UDT is passed to the second
' object.
Public Sub ShowDemo(ByVal Title As String, _
ByVal Direction As String)
MsgBox Direction & " " _
& GetDebugString(Me) & vbCrLf & vbCrLf _
& mDemo.intA & vbCrLf _
& mDemo.lngB & vbCrLf _
& mDemo.strC, , Title
End Sub
Private Sub Class_Initialize()
mlngDebugID = DebugInit(Me)
End Sub
Private Sub Class_Terminate()
DebugTerm Me
End Sub
' -------- IDebug Implementation --------
'
' IDebug.DebugID gives you a way to tell
' ====== ------- objects apart. It's
' required by the DebugInit, DebugTerm,
' and DebugShow debugging procedures
' declared in modFriend.
'
Private Property Get IDebug_DebugID() As Long
IDebug_DebugID = mlngDebugID
End Property