109 lines
2.6 KiB
QBasic
109 lines
2.6 KiB
QBasic
Attribute VB_Name = "MDebug"
|
|
Option Explicit
|
|
|
|
'$ Uses UTILITY.BAS
|
|
|
|
Private iLogFile As Integer
|
|
|
|
Private secFreq As Currency
|
|
|
|
' Output flags determine output destination of BugAsserts and messages
|
|
#Const afLogfile = 1
|
|
#Const afMsgBox = 2
|
|
#Const afDebugWin = 4
|
|
#Const afAppLog = 8
|
|
|
|
Function BugInit() As Boolean
|
|
BugInit = QueryPerformanceCounter(secFreq)
|
|
End Function
|
|
|
|
' Display appropriate error message, and then stop
|
|
' program. These errors should NOT be possible in
|
|
' shipping product.
|
|
Sub BugAssert(ByVal fExpression As Boolean, _
|
|
Optional sExpression As String)
|
|
#If afDebug Then
|
|
If fExpression Then Exit Sub
|
|
BugMessage "BugAssert failed: " & sExpression
|
|
Stop
|
|
#End If
|
|
End Sub
|
|
|
|
|
|
Sub BugMessage(sMsg As String)
|
|
#If afDebug And afLogfile Then
|
|
If iLogFile = 0 Then
|
|
iLogFile = FreeFile
|
|
' Warning: multiple instances can overwrite log file
|
|
Open App.ExeName & ".DBG" For Output Shared As iLogFile
|
|
' Challenge: Rewrite to give each instance its own log file
|
|
End If
|
|
Print #iLogFile, sMsg
|
|
#End If
|
|
#If afDebug And afMsgBox Then
|
|
MsgBox sMsg
|
|
#End If
|
|
#If afDebug And afDebugWin Then
|
|
Debug.Print sMsg
|
|
#End If
|
|
#If afDebug And afAppLog Then
|
|
App.LogEvent sMsg
|
|
#End If
|
|
End Sub
|
|
|
|
Sub BugLocalMessage(sMsg As String)
|
|
#If fDebugLocal Then
|
|
BugMessage sMsg
|
|
#End If
|
|
End Sub
|
|
|
|
Sub BugTerm()
|
|
#If afDebug And afLogfile Then
|
|
' Close log file
|
|
Close iLogFile
|
|
#End If
|
|
End Sub
|
|
|
|
Sub ProfileStart(secStart As Currency)
|
|
If secFreq = 0 Then QueryPerformanceFrequency secFreq
|
|
QueryPerformanceCounter secStart
|
|
End Sub
|
|
|
|
Sub ProfileStop(secStart As Currency, secTiming As Currency)
|
|
QueryPerformanceCounter secTiming
|
|
If secFreq = 0 Then
|
|
secTiming = 0 ' Handle no high-resolution timer
|
|
Else
|
|
secTiming = (secTiming - secStart) / secFreq
|
|
End If
|
|
End Sub
|
|
|
|
Sub ProfileStopMessage(sOutput As String, sPrefix As String, _
|
|
secStart As Currency, sPost As String)
|
|
#If afDebug Then
|
|
Static secTiming As Currency
|
|
QueryPerformanceCounter secTiming
|
|
If secFreq = 0 Then
|
|
secTiming = 0 ' Handle no high-resolution timer
|
|
Else
|
|
secTiming = (secTiming - secStart) / secFreq
|
|
End If
|
|
' Return through parameter so that routine can be Sub
|
|
sOutput = sPrefix & secTiming & sPost
|
|
#End If
|
|
End Sub
|
|
|
|
Sub BugProfileStop(sPrefix As String, secStart As Currency)
|
|
#If afDebug Then
|
|
Static secTiming As Currency
|
|
QueryPerformanceCounter secTiming
|
|
If secFreq = 0 Then
|
|
secTiming = 0 ' Handle no high-resolution timer
|
|
Else
|
|
secTiming = secTiming - secStart / secFreq
|
|
End If
|
|
BugMessage sPrefix & secTiming & " sec "
|
|
#End If
|
|
End Sub
|
|
|