VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "TraceObject"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'
' local property storage
Private trcFileName As String
Private trcFlag As Boolean
'
' internal variables
Private trcStack() As String
Private trcPointer As Long

Public Property Get TraceFileName() As String
Attribute TraceFileName.VB_Description = "Target file for Trace.Dump"
    '
    TraceFileName = trcFileName
    '
End Property

Public Property Let TraceFileName(ByVal vNewValue As String)
    '
    trcFileName = vNewValue
    '
End Property

Public Property Get TraceFlag() As Boolean
Attribute TraceFlag.VB_Description = "Toggles Tracing On/Off (True/False)"
    '
    TraceFlag = trcFlag
    '
End Property

Public Property Let TraceFlag(ByVal vNewValue As Boolean)
    '
    trcFlag = vNewValue
    '
End Property

Private Sub Class_Initialize()
    '
    ' startup stuff
    trcFileName = App.EXEName & ".trc"
    trcFlag = False
    '
End Sub

Public Sub Push(ProcName As String)
Attribute Push.VB_Description = "Pushes an item onto the Trace stack."
    '
    ' push a proc onto the stack
    trcPointer = trcPointer + 1
    ReDim Preserve trcStack(trcPointer)
    trcStack(trcPointer) = ProcName
    '
End Sub

Public Sub Pop()
Attribute Pop.VB_Description = "Pops an item off the trace stack"
    '
    ' pop a proc off the stack
    If trcPointer <> 0 Then
        trcPointer = trcPointer - 1
        ReDim Preserve trcStack(trcPointer)
    End If
    '
End Sub

Public Function List() As Variant
Attribute List.VB_Description = "Returns a one-dimensional variant array of the trace stack."
    '
    ' return an array of the trace log
    List = trcStack
    '
End Function

Public Sub Dump()
Attribute Dump.VB_Description = "Writes Trace stack to a file (see TraceFileName)"
    '
    ' write trace log to file
    Dim intFile As Integer
    Dim intLoop As Integer
    '
    intFile = FreeFile
    Open trcFileName For Append As intFile
        Print #intFile, "*** TRACE STACK DUMP ***"
        Print #intFile, "*** DATE: " & Format(Now(), "general date")
        Print #intFile, ""
        '
        For intLoop = trcPointer To 1 Step -1
            Print #intFile, vbTab & Format(intLoop, "000") & ": " & trcStack(intLoop)
        Next
        '
        Print #intFile, ""
        Print #intFile, "*** EOF"
    Close #intFile
    '
    Exit Sub
    '
LocalErr:
    Err.Raise vbObjectError + 3, "Trace.Dump", "Can't write trace file [" & trcFileName & "]"
    '
End Sub

Public Sub Clear()
Attribute Clear.VB_Description = "Clears Trace stack"
    '
    ' clear off the stack
    trcPointer = 0
    ReDim Preserve trcStack(0)
    '
End Sub

Public Sub Show()
Attribute Show.VB_Description = "Displays the current Trace stack in a dialog box."
    '
    ' show trace log in dialog
    '
    Dim intLoop As Integer
    Dim strMsg As String
    '
    strMsg = ""
    For intLoop = trcPointer To 1 Step -1
        strMsg = strMsg & Format(intLoop, "000")
        strMsg = strMsg & ": "
        strMsg = strMsg & Trim(trcStack(intLoop))
        strMsg = strMsg & vbCrLf
    Next
    '
    MsgBox strMsg, vbInformation, "Trace Stack"
    '
End Sub
