Module TraceWindow

Share your advanced PureBasic knowledge/code with the community.
User avatar
mk-soft
Addict
Addict
Posts: 3071
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Module TraceWindow

Post by mk-soft »

A way to debugging program without PB-Debugger.
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
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace