It is currently Sat Nov 28, 2020 1:16 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 1 post ] 
Author Message
 Post subject: Module TraceWindow
PostPosted: Fri Apr 10, 2020 12:47 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2730
Location: Germany
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

_________________
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


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 1 post ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 8 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye