If threads are used, enable compiler option ThreadSafe!
Code: Select all
;-TOP
; Comment : Own Trace Window
; Author : mk-soft
; Version : v1.01.4
; Create : 10.04.2020
; Update :
; Check FirstMenuItem Number
;- Begin Trace Module
CompilerIf #True ; Set false to remove all trace code
DeclareModule _Trace
Declare AddText(Info.s, Modul.s, Proc.s, Line)
Declare HideTraceWindow(State) ; True, False, -1 = Toggle
EndDeclareModule
Module _Trace
EnableExplicit
#FirstMenuItem = 64000
Enumeration #FirstMenuItem
#MenuItemStop
#MenuItemResume
#MenuItemCopy
EndEnumeration
Global TraceWindow, TraceMenu, TraceList, TraceStop
; ----
Procedure DoTraceEventMenu()
Protected cnt, i, r1.s
Select EventMenu()
Case #MenuItemStop
TraceStop = #True
Case #MenuItemResume
TraceStop = #False
cnt = CountGadgetItems(TraceList) - 1
SetGadgetState(TraceList, cnt)
SetGadgetState(TraceList, -1)
Case #MenuItemCopy
cnt = CountGadgetItems(TraceList) - 1
For i = 0 To cnt
r1 + GetGadgetItemText(TraceList, i) + #LF$
Next
SetClipboardText(r1)
EndSelect
EndProcedure
; ----
Procedure DoTraceEventGadget()
Protected *msg.String, cnt
Select EventGadget()
Case TraceList
Select EventType()
Case #PB_EventType_FirstCustomValue
*msg = EventData()
If *msg
If TraceList And IsGadget(TraceList)
cnt = CountGadgetItems(TraceList)
AddGadgetItem(TraceList, -1, *msg\s)
If Not TraceStop
SetGadgetState(TraceList, cnt)
SetGadgetState(TraceList, -1)
EndIf
If cnt >= 10000
RemoveGadgetItem(TraceList, 0)
EndIf
EndIf
FreeStructure(*msg)
EndIf
Case #PB_EventType_RightClick
DisplayPopupMenu(TraceMenu, WindowID(TraceWindow))
EndSelect
EndSelect
EndProcedure
; ----
Procedure DoTraceEventSizeWindow()
ResizeGadget(TraceList, 0, 0, WindowWidth(TraceWindow), WindowHeight(TraceWindow))
EndProcedure
; ----
Procedure DoTraceEventCloseWindow()
SetWindowState(TraceWindow, #PB_Window_Minimize)
EndProcedure
; ----
Procedure OpenTraceWindow()
Protected Style, Title.s, ActWindow
If Not TraceWindow
ActWindow = GetActiveWindow()
Title = "Trace [" + ProgramFilename() + "]"
Style = #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget
TraceWindow = OpenWindow(#PB_Any, #PB_Ignore, #PB_Ignore, 600, 800, Title, Style)
If TraceWindow
; PopupMenu
TraceMenu = CreatePopupMenu(#PB_Any)
MenuItem(#MenuItemStop, "Stop Scroll")
MenuItem(#MenuItemResume, "Resume Scroll")
MenuBar()
MenuItem(#MenuItemCopy, "Copy List")
; Gadget
TraceList = ListViewGadget(#PB_Any, 0, 0, 600, 800, #PB_ListView_MultiSelect)
; Bind Events
BindEvent(#PB_Event_Gadget, @DoTraceEventGadget(), TraceWindow, TraceList)
BindEvent(#PB_Event_Menu, @DoTraceEventMenu(), TraceWindow)
BindEvent(#PB_Event_SizeWindow, @DoTraceEventSizeWindow(), TraceWindow)
BindEvent(#PB_Event_CloseWindow, @DoTraceEventCloseWindow(), TraceWindow)
EndIf
SetActiveWindow(ActWindow)
EndIf
EndProcedure
; ----
Procedure AddText(Info.s, Modul.s, Proc.s, Line)
Protected *msg.String = AllocateStructure(String)
If Not TraceWindow
OpenTraceWindow()
EndIf
If *msg
If Modul = ""
Modul = "*"
EndIf
*msg\s = FormatDate("[%HH:%II:%SS] ", Date())
*msg\s + "[Module " + Modul + " / Proc " + Proc + " / Line " + Line + "] " + Info
PostEvent(#PB_Event_Gadget, TraceWindow, TraceList, #PB_EventType_FirstCustomValue, *msg)
EndIf
EndProcedure
; ----
Procedure HideTraceWindow(State)
Static last_state
If Not TraceWindow
OpenTraceWindow()
EndIf
Select State
Case #False
HideWindow(TraceWindow, #False, #PB_Window_NoActivate)
last_state = #False
Case #True
HideWindow(TraceWindow, #True, #PB_Window_NoActivate)
last_state = #True
Case -1
If last_state
HideWindow(TraceWindow, #False, #PB_Window_NoActivate)
last_state = #False
Else
HideWindow(TraceWindow, #True, #PB_Window_NoActivate)
last_state = #True
EndIf
EndSelect
EndProcedure
EndModule
; ----
Macro Trace(Info, Modul = #PB_Compiler_Module, Proc = #PB_Compiler_Procedure, Line = #PB_Compiler_Line)
_Trace::AddText(Info, Modul, Proc, Line)
EndMacro
Macro HideTraceWindow(State)
_Trace::HideTraceWindow(State)
EndMacro
CompilerElse
Macro Trace(Info, Modul = #PB_Compiler_Module, Proc = #PB_Compiler_Procedure, Line = #PB_Compiler_Line)
EndMacro
Macro HideTraceWindow(State)
EndMacro
CompilerEndIf
;- End Trace Module
; ********
;- Example
CompilerIf #PB_Compiler_IsMainFile
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
Declare thWork(id)
#MenuItem_Trace = 10000
;- 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, "Run")
AddStatusBarField(#PB_Ignore)
;-- Create Gadget
ListViewGadget(#MainList, 0, 0, #MainWidth, #MainHeight - StatusBarHeight(#MainStatusBar))
Trace("Program started")
AddKeyboardShortcut(#Main, #PB_Shortcut_Alt | #PB_Shortcut_T, #MenuItem_Trace)
CreateThread(@thWork(), 0)
;-- EventLoop
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_CloseWindow
If EventWindow() = #Main
ExitApplication = #True
EndIf
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
Case #MenuItem_Trace
HideTraceWindow(-1)
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
Procedure thWork(id)
Protected cnt
Repeat
cnt + 1
Trace("Thread Counter " + cnt)
Delay(1000)
Until ExitApplication
EndProcedure
CompilerEndIf