Class / Collection Debugging

[rjbudz]

This may help to find problems when using Classes or Collections of classes. It's an application that creates a function that outputs to the Immediate Window all of a classes' variable values. (Yeah, that was long-winded but it is what it is.)

Here’s how it works. From the class you already created, copy & paste the class header into the Input textbox. The app's output textbox will display a function. Click Copy to Clipboard, and then paste it at the bottom of your class.

It's commented to death. I want new programmers to understand it. The code contains instructions and sample input/output

Here's what you need to make it work:

1) A new project

2 Two textboxes on the default form:
Set attributes to:
(name) txtInput
Font Courier New
Font Size 10
MultiLine True
scroll 3-Both
Text ""

(name) txtOuput
Font Courier New
Font Size 10
Locked True
MultiLine True
scroll 3-Both
Text ""

3) Two buttons :

(name) cmdClearTextBoxes
Text Clear Textboxes

(name) cmdCopyToClipboard
Text Copy To Clipboard


4) This Code:

Option Explicit
 
Private Sub txtInput_Change()
    ' paste all class header variable declarations in Input textbox
    ' copy text in Output textboxes to bottom of class
    ' call function when you need to know
 
'   Example: paste to Input textbox
'
'   'local variable(s) to hold property value(s)
'   Private mvarLineContent As String 'local copy
'   'local variable(s) to hold property value(s)
'   Private mvarEntryDate As String 'local copy
'   'local variable(s) to hold property value(s)
'   Private mvarEntryTime As String 'local copy
'
'   Ouptut textbox will contain:
'
'   Public Function ShowAll()
'     ' For debugging. shows values of all variables in class instance
'     ' SYNTAX: in class instance: [instanceName].ShowAll
'     ' SYNTAX: in collection of class instance: [collectionName].([index])ShowAll
'     '
'     ' Author: Robert Budzynowski
'
'       Debug.Print "LineContent = {" & mvarLineContent & "}"
'       Debug.Print "EntryDate = {" & mvarEntryDate & "}"
'       Debug.Print "EntryTime = {" & mvarEntryTime & "}"
'
'   End Function
 
    Dim lines() As String
    Dim x As Integer
    Dim mvarLoc As Integer
    Dim SpaceLoc As Integer
    Dim classVarName As String
    Dim varName As String
    Dim trimmedLine As String
    Dim processInput As Boolean
    
    ' no point if no class header data
    mvarLoc = InStr(UCase(txtInput.Text), "MVAR")
    
    If mvarLoc = 0 Then
        MsgBox "Text entered does not contain class header data", vbOKOnly, "Input Error"
        
        ' clear existing output text
        txtOuput.Text = ""
        
        ' highlight text
        txtInput.SelStart = 0
        txtInput.SelLength = Len(txtInput.Text)
        txtInput.SetFocus
    End If
     
    ' function header & description
    txtOuput = "Public Function ShowAll()" & vbCrLf
    txtOuput = txtOuput & "  ' For debugging. shows values of all variables in class instance" & vbCrLf
    txtOuput = txtOuput & "  ' SYNTAX: in class instance: [instanceName].ShowAll" & vbCrLf
    txtOuput = txtOuput & "  ' SYNTAX: in collection of class instance: [collectionName].([index])ShowAll" & vbCrLf
    
    ' please give credit where credit is due!
    txtOuput = txtOuput & "  ' " & vbCrLf
    txtOuput = txtOuput & "  ' Author: Robert Budzynowski" & vbCrLf
    txtOuput = txtOuput & vbCrLf
 
    ' create array element for each line in input textbox
    lines = Split(txtOuput.Text, vbCrLf)
    
    ' process each line of input textbox
    For x = 0 To UBound(lines)
    
        ' check for "mvar" text is line, if so we work with it
        mvarLoc = InStr(UCase(lines(x)), "MVAR")
        
        If mvarLoc > 0 Then
            ' valid line. Trim everything prior to start of var name (usually "Private ")
            trimmedLine = Right(lines(x), Len(lines(x)) - mvarLoc + 1)
            
            ' find the space after the var name
            SpaceLoc = InStr(trimmedLine, " ")
          
            ' the modular var name is before the space
            classVarName = Trim(Left(trimmedLine, SpaceLoc))
            
            ' get the var name without the mvar prefix
            varName = Right(classVarName, Len(classVarName) - Len("mvar"))
                        
            ' this is the line you want
            txtOuput = txtOuput & vbTab & "Debug.Print " & Chr(34) & varName & " = {" & Chr(34) & " & " & classVarName & " & " & Chr(34) & "}" & Chr(34) & " " & vbCrLf
            
        End If
 
    Next x
    
    ' finish function text
    txtOuput = txtOuput & vbCrLf
    txtOuput = txtOuput & "End Function"
 
End Sub
 
Private Sub cmdClearTextBoxes_Click()
' clear textboxes
    txtInput.Text = ""
    txtOuput.Text = ""
End Sub
 
Private Sub cmdCopyToClipboard_Click()
' copy output text
  Clipboard.Clear
  Clipboard.SetText txtOuput.Text
End Sub
 
End Sub

[rjbudz]

BTW, the code listing above has an extra End Sub at the end. Delete it.

[bushmobile]

BTW, the code listing above has an extra End Sub at the end. Delete it.

you can Edit your post and change it.

aside from the little bugs, your code suffers from a few problems
- the variables have to be consistently named
- if you put the variable name in a comment it'll try and parse that too
- it'll flake out on objects and arrays

it's basically not robust enough to be usable by a wide range of people

the VB code at the bottom will take the input (you can put the whole code in or just the declarations) and parse out the variables regardless of names. e.g.

Option Explicit

Private m_cATBar As New cActiveTitleBar
Private m_cSize As New cSizeWin

Private Type POINTAPI
        x As Long
        y As Long
End Type

Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long

Private Const iGap As Integer = 8

Private Type LOGFONT
  lfHeight As Long
  lfWidth As Long
  lfEscapement As Long
  lfOrientation As Long
  lfWeight As Long
  lfItalic As Byte
  lfUnderline As Byte
  lfStrikeOut As Byte
  lfCharSet As Byte
  lfOutPrecision As Byte
  lfClipPrecision As Byte
  lfQuality As Byte
  lfPitchAndFamily As Byte
  lfFaceName As String * 33
End Type

Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Const ANSI_CHARSET As Long = 0
Const FF_DONTCARE As Long = 0
Const CLIP_LH_ANGLES As Long = &H10
Const CLIP_DEFAULT_PRECIS As Long = 0
Const OUT_TT_ONLY_PRECIS As Long = 7
Const PROOF_QUALITY As Long = 2
Const TRUETYPE_FONTTYPE As Long = &H4
Const p_WIDTH As Long = 6
Const p_HEIGHT As Long = 10

Private m_cIl As cVBALImageList

Private iColOver As Integer
Private iColPress As Integer

Private lTextHeight As Long
Private lTextWidth As Long
Private lSmallWidth As Long

will give

Public Sub ShowAll()
    On Error Resume Next
    If Not TypeName(m_cATBar) = "Object" Then Debug.Print "m_cATBar (" & TypeName(m_cATBar) & ") = " & m_cATBar
    If Not TypeName(m_cSize) = "Object" Then Debug.Print "m_cSize (" & TypeName(m_cSize) & ") = " & m_cSize
    If Not TypeName(m_cIl) = "Object" Then Debug.Print "m_cIl (" & TypeName(m_cIl) & ") = " & m_cIl
    If Not TypeName(iColOver) = "Object" Then Debug.Print "iColOver (" & TypeName(iColOver) & ") = " & iColOver
    If Not TypeName(iColPress) = "Object" Then Debug.Print "iColPress (" & TypeName(iColPress) & ") = " & iColPress
    If Not TypeName(lTextHeight) = "Object" Then Debug.Print "lTextHeight (" & TypeName(lTextHeight) & ") = " & lTextHeight
    If Not TypeName(lTextWidth) = "Object" Then Debug.Print "lTextWidth (" & TypeName(lTextWidth) & ") = " & lTextWidth
    If Not TypeName(lSmallWidth) = "Object" Then Debug.Print "lSmallWidth (" & TypeName(lSmallWidth) & ") = " & lSmallWidth
End Sub

it should be fairly robust:

Private Sub Command1_Click()
    Const sTAB As String = "    "
    Dim sLines() As String
    Dim sParts() As String
    Dim sSub As String
    Dim N As Long, I As Long
 
    If Len(Trim$(txtInput.Text)) = 0 Then Exit Sub
    
    sSub = "Public Sub ShowAll()" & vbCrLf & sTAB & "On Error Resume Next" & vbCrLf
    
    sLines = Split(txtInput.Text, vbCrLf)
    For N = 0 To UBound(sLines)
        ' Remove spaces
        sLines(N) = Trim$(sLines(N))
        ' make sure it's not blank
        If Len(sLines(N)) Then
            ' check it's not a comment
            If Not Asc(sLines(N)) = 39 Then
                ' Get each part
                sParts = Split(sLines(N), " ")
                    ' Check we have enough words
                If UBound(sParts) Then
                    ' check it's a declaration
                    Select Case UCase$(sParts(0))
                        Case "PRIVATE", "PUBLIC", "DIM"
                            ' check it's a variable
                            Select Case UCase$(sParts(1))
                                Case "DECLARE", "CONST", "TYPE", "ENUM", "PROPERTY"
                                Case "FUNCTION", "SUB"
                                    ' Exit
                                    Exit For
                                Case Else
                                    If InStr(sParts(1), "(") Then
                                        ' It's an array
                                    Else
                                        ' it's valid - construct line:
                                        ' If Not TypeName(varName) = "Object" Then Debug.Print "varName(" & TypeName(varName) & ") = " & varName
                                        sSub = sSub & sTAB & "If Not TypeName(" & sParts(1) & _
                                               ") = ""Object"" Then Debug.Print """ & sParts(1) & _
                                               " ("" & TypeName(" & sParts(1) & ") & "") = "" & " & sParts(1) & vbCrLf
                                    End If
                            End Select
                        Case "FUNCTION", "SUB"
                            ' Exit
                            Exit For
                    End Select
                End If
            End If
        End If
    Next N
                            
    sSub = sSub & "End Sub"
    txtOutput.Text = sSub
End Sub

where it says It's an array you could add code to construct a loop through the array, but i couldn't be bothered

[rjbudz]

The pvital line of code should be

lines = Split(txtInput.Text, vbCrLf)

not

lines = Split(txOutput.Text, vbCrLf)

[rjbudz]

The object of the code submission was to take a simple class definition and allow the developer to quicly create something to output the variables for troubleshooting. I, myself, seldom use classes to hold objects. I'm glad you were able to flesh it out to be as robust as you have.

[bushmobile]

The object of the code submission was to take a simple class definition and allow the developer to quicly create something to output the variables for troubleshooting. I, myself, seldom use classes to hold objects. I'm glad you were able to flesh it out to be as robust as you have.

well i mainly wrote it so that it would pick up a variable regardless of what it was called - i don't think i've ever written any piece of code in which every variable name has a common section.