Standard window for testing codes with threadsafe tracing
Code: Select all
;-TOP
; -----------------------------------------------------------------------------
CompilerIf #PB_Compiler_Thread = 0
CompilerError "Use Compiler-Option ThreadSafe"
CompilerEndIf
; -----------------------------------------------------------------------------
Enumeration FormWindow
#Main
EndEnumeration
Enumeration FormGadget
#MainList
EndEnumeration
Enumeration FormStatusBar
#MainStatusBar
EndEnumeration
Enumeration CustomEvent #PB_Event_FirstCustomValue
#MyEvent_Trace
EndEnumeration
; -----------------------------------------------------------------------------
Global ExitApplication
; -----------------------------------------------------------------------------
;#TraceList = -1 ; Use Debugger output
#TraceList = #MainList
Procedure __Trace(Info.s, Modul.s, Proc.s, Line)
Protected *msg.String = AllocateStructure(String)
If Modul = ""
Modul = "MainScope"
EndIf
*msg\s = FormatDate("[%HH:%II:%SS] ", Date())
*msg\s + "{Module " + Modul + "|Proc " + Proc + "|Line " + Line + "} " + Info
PostEvent(#MyEvent_Trace, 0, 0, 0, *msg)
EndProcedure
; ---
Procedure DoEventTrace()
Protected *msg.String, cnt
*msg = EventData()
If *msg
If #TraceList >= 0 And IsGadget(#TraceList)
cnt = CountGadgetItems(#TraceList)
AddGadgetItem(#TraceList, -1, *msg\s)
SetGadgetState(#TraceList, cnt)
SetGadgetState(#TraceList, -1)
If cnt >= 1000
RemoveGadgetItem(#TraceList, 0)
EndIf
Else
Debug *msg\s
EndIf
FreeStructure(*msg)
EndIf
EndProcedure
; ---
Macro Trace(Info, Modul = #PB_Compiler_Module, Proc = #PB_Compiler_Procedure, Line = #PB_Compiler_Line)
__Trace(Info, Modul, Proc, Line)
EndMacro
BindEvent(#MyEvent_Trace, @DoEventTrace())
; -----------------------------------------------------------------------------
Procedure DoEventSizeWindow()
ResizeGadget(#MainList, 0, 0, WindowWidth(#Main), WindowHeight(#Main) - StatusBarHeight(#MainStatusBar))
EndProcedure
; -----------------------------------------------------------------------------
Declare thWork(id)
;- Main
Procedure Main()
Protected Event, ExitTime
#MainWidth = 800
#MainHeight = 600
#MainStyle = #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget
If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, #MainWidth, #MainHeight, "Main Window", #MainStyle)
;-- Create StatusBar
CreateStatusBar(#MainStatusBar, WindowID(#Main))
AddStatusBarField(100) : StatusBarText(#MainStatusBar, 0, "State")
AddStatusBarField(#PB_Ignore)
;-- Create Gadget
ListViewGadget(#MainList, 0, 0, #MainWidth, #MainHeight - StatusBarHeight(#MainStatusBar))
;-- BindEvent
BindEvent(#PB_Event_SizeWindow, @DoEventSizeWindow(), #Main)
Trace("Program started")
;-- EventLoop
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_CloseWindow
ExitApplication = #True
Case #PB_Event_Menu
Select EventMenu()
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
Case #PB_Menu_About
Case #PB_Menu_Preferences
Case #PB_Menu_Quit
ExitApplication = #True
CompilerEndIf
EndSelect
EndSelect
Until ExitApplication
;-- ExitProgram
Trace("Exit Program (Wait 2 Seconds)")
ExitTime = ElapsedMilliseconds()
Repeat
WaitWindowEvent(100)
If ElapsedMilliseconds() - ExitTime >= 2000
Break
EndIf
ForEver
EndIf
EndProcedure : Main()
End
; -----------------------------------------------------------------------------