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/