PureBasic Forum http://forums.purebasic.com/english/ |
|
Module TraceWindow http://forums.purebasic.com/english/viewtopic.php?f=12&t=75068 |
Page 1 of 1 |
Author: | mk-soft [ Fri Apr 10, 2020 12:47 pm ] |
Post subject: | Module TraceWindow |
A way to debugging program without PB-Debugger. If threads are used, enable compiler option ThreadSafe! Code: ;-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 |
Page 1 of 1 | All times are UTC + 1 hour |
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group http://www.phpbb.com/ |