PureBasic Forums - English

Code: Select all

;-TOP

CompilerIf Not #PB_Compiler_Thread
  CompilerError "Use Compiler Option ThreadSage!"
CompilerEndIf

Enumeration Windows
  #Main
EndEnumeration

Enumeration MenuBar
  #MainMenu
EndEnumeration

Enumeration MenuItems
  #MainMenuItemExit
EndEnumeration

Enumeration Gadgets
  #MainTraceList
EndEnumeration

Enumeration StatusBar
  #MainStatusBar
EndEnumeration

; ----

Enumeration CustomEvent #PB_Event_FirstCustomValue
  #MyEvent_Trace
EndEnumeration

; ---- String Helper ----
  
Procedure AllocateString(String.s) ; Result = Pointer
  Protected *mem.string = AllocateStructure(String)
  If *mem
    *mem\s = String
  EndIf
  ProcedureReturn *mem
EndProcedure

Procedure.s FreeString(*mem.string) ; Result String
  Protected r1.s
  If *mem
    r1 = *mem\s
    FreeStructure(*mem)
  EndIf
  ProcedureReturn r1
EndProcedure

; ----

Procedure DoEventTrace()
  Protected *data, cnt
  *data = EventData()
  If *data
    cnt = CountGadgetItems(#MainTraceList)
    AddGadgetItem(#MainTraceList, -1, FreeString(*data))
    SetGadgetState(#MainTraceList, cnt) 
    If cnt & $01 
      SetGadgetItemColor(#MainTraceList, cnt, #PB_Gadget_BackColor, #Yellow)
    EndIf 
    SetGadgetState(#MainTraceList, -1)
    If cnt >= 1000
      RemoveGadgetItem(#MainTraceList, 0)
    EndIf
  EndIf
EndProcedure : BindEvent(#MyEvent_Trace, @DoEventTrace())

Procedure __Trace(Info.s, Modul.s, Proc.s, Line)
  Protected Text.s
  If Modul = ""
    Modul = "Main"
  EndIf
  Text = FormatDate("[%HH:%II:%SS] ", Date())
  Text + "[Module " + Modul + "; Proc " + Proc + "; Line " + Line + "] " + Info
  PostEvent(#MyEvent_Trace, 0, 0, 0, AllocateString(Text))  
EndProcedure

Macro Trace(Info, Modul = #PB_Compiler_Module, Proc = #PB_Compiler_Procedure, Line = #PB_Compiler_Line)
  __Trace(Info, Modul, Proc, Line)
EndMacro

; ----

Procedure UpdateWindow()
  Protected dx, dy
  dx = WindowWidth(#Main)
  dy = WindowHeight(#Main) - StatusBarHeight(#MainStatusBar) - MenuHeight()
  ; Resize gadgets
  ResizeGadget(#MainTraceList, 0, 0, dx, dy)
EndProcedure

Procedure Main()
  Protected dx, dy
  Protected ExitTime
  
  #MainStyle = #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget
  
  If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, 800, 600, "Window" , #MainStyle)
    ; Menu
    CreateMenu(#MainMenu, WindowID(#Main))
    MenuTitle("&File")
    MenuItem(#MainMenuItemExit, "E&xit")
    
    ; StatusBar
    CreateStatusBar(#MainStatusBar, WindowID(#Main))
    AddStatusBarField(#PB_Ignore)
    
    ; Gadgets
    dx = WindowWidth(#Main)
    dy = WindowHeight(#Main) - StatusBarHeight(#MainStatusBar) - MenuHeight()
;   ListViewGadget(#MainTraceList, 0, 0, dx, dy)
    ListIconGadget(#MainTraceList, 0, 0, dx, dy, "Messages", dy-24, #PB_ListIcon_FullRowSelect)
    
    ; Bind Events
    BindEvent(#PB_Event_SizeWindow, @UpdateWindow(), #Main)
    
    For i = 1 To 10
      Trace("Count " + i)
    Next
    
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          Select EventWindow()
            Case #Main
              Break
              
          EndSelect
          
        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
                PostEvent(#PB_Event_CloseWindow, #Main, #Null)
                
            CompilerEndIf
            
          Case #MainMenuItemExit
            PostEvent(#PB_Event_CloseWindow, #Main, #Null)
            
          EndSelect
          
        Case #PB_Event_Gadget
          Select EventGadget()
              
          EndSelect
          
      EndSelect
    ForEver
    
    ;-- ExitProgram
    Trace("Exit Program (Wait 1 Seconds)")
    
    ExitTime = ElapsedMilliseconds()
    Repeat
      WaitWindowEvent(10)
      If ElapsedMilliseconds() - ExitTime >= 1000
        Break
      EndIf
    ForEver
    
  EndIf
  
EndProcedure : Main()

Code: Select all

 
; Windows Only Code as an addition to the above code 
Macro SetListIconGadgetNoHorzScrollbar(Gadget)
  SendMessage_(GadgetID(Gadget), #LVM_SETCOLUMNWIDTH, 0, #LVSCW_AUTOSIZE_USEHEADER)
  ShowScrollBar_(GadgetID(Gadget), #SB_HORZ, #False) 
EndMacro

Macro SetListIconGadgetNoHeader(Gadget) 
  SetWindowLongPtr_(GadgetID(Gadget), #GWL_STYLE, GetWindowLongPtr_(GadgetID(Gadget), #GWL_STYLE)|#LVS_NOCOLUMNHEADER) 
EndMacro 

; ... behind this line: 
; ListIconGadget(#MainTraceList, 0, 0, dx, dy, "Messages", dy-24, #PB_ListIcon_FullRowSelect)
; add here to have the same look as ListViewGadget  
SetListIconGadgetNoHeader(#MainTraceList) 
SetListIconGadgetNoHorzScrollbar(#MainTraceList)