How to create unblocked Events

mk-soft · Post by **mk-soft** » Wed Oct 21, 2015 8:19 pm

Menu or Resize Windows blocked events. AddGadgetItem from the Thread don't work exactly.
PostEvent lost sometime valid EventData and sometime crashed the program.

Stable example, but Menu or ResizeWindows blocked the Thread

Code: Select all

;-TOP

; ***************************************************************************************

;- Include SendEvent

; Comment : SendEvent
; Author  : mk-soft
; Version : v1.05

; Structure
Structure udtSendEvent
  Signal.i
  Result.i
  *pData
EndStructure

; ---------------------------------------------------------------------------------------

Procedure SendEvent(Event, Window = 0, Object = 0, EventType = 0, pData = 0, Semaphore = 0)
 
  Protected MyEvent.udtSendEvent, result
 
  With MyEvent
    If Semaphore
      \Signal = Semaphore
    Else
      \Signal = CreateSemaphore()
    EndIf
    \pData = pData
    PostEvent(Event, Window, Object, EventType, @MyEvent)
    WaitSemaphore(\Signal)
    result = \Result
    If Semaphore = 0
      FreeSemaphore(\Signal)
    EndIf
  EndWith
 
  ProcedureReturn result
 
EndProcedure

; ---------------------------------------------------------------------------------------

Procedure SendEventData(*MyEvent.udtSendEvent)
 
   ProcedureReturn *MyEvent\pData
 
EndProcedure

; ---------------------------------------------------------------------------------------

Procedure DispatchEvent(*MyEvent.udtSendEvent, result)
 
  *MyEvent\Result = result
  SignalSemaphore(*MyEvent\Signal)
 
EndProcedure

; ***************************************************************************************

;- Part Declare Main

Enumeration ;Window
  #Main
EndEnumeration

Enumeration ; Menu
  #Menu
EndEnumeration

Enumeration ; MenuItems
  #MenuExit
EndEnumeration
  
Enumeration ; Gadgets
  #Splitter
  #List
  #Edit
EndEnumeration

Enumeration ; Statusbar
  #Status
EndEnumeration

; Global Variable
Global exit

; ***************************************************************************************

; Functions
Procedure UpdateWindow()
  
  Protected x, y, dx, dy, menu, status
  
  menu = MenuHeight()
  If IsStatusBar(#Status)
    status = StatusBarHeight(#Status)
  Else
    status = 0
  EndIf
  x = 0
  y = 0
  dx = WindowWidth(#Main)
  dy = WindowHeight(#Main) - menu - status
  ResizeGadget(#Splitter, x, y, dx, dy)
  
EndProcedure

; ***************************************************************************************

;- Part Write Logs

Procedure MyLogs(Text.s)
  
  Protected temp.s, c
  
  temp = FormatDate("%HH.%II.%SS - ", Date())
  temp + Text
  AddGadgetItem(#List, -1, temp)
  c = CountGadgetItems(#List)
  If c > 1000
    RemoveGadgetItem(#List, 0)
    c - 1
  EndIf
  c - 1
  SetGadgetState(#List, c)
  SetGadgetState(#List, -1)
  
EndProcedure

Global MutexLogs = CreateMutex()

Macro Logs(Text)
  LockMutex(MutexLogs) : MyLogs(Text) : UnlockMutex(MutexLogs)
EndMacro

; ***************************************************************************************

;- Part Thread

Enumeration #PB_Event_FirstCustomValue
  #My_Event_Data
EndEnumeration

; Thread
Procedure MyThread(Void)
 
  Protected c, result, text.s
 
  text = "Init Thread"
  SendEvent(#My_Event_Data, 0, 0, 0, @text)
  
  Repeat
    text = "Counter " + Str(c)
    result = SendEvent(#My_Event_Data, 0, 0, 0, @text)
    ;Debug "Result: " + Str(result)
    c + 1
    Delay(1000)
  Until c > 3600
  
  text = "Exit Thread"
  SendEvent(#My_Event_Data, 0, 0, 0, @text)
  
EndProcedure

Procedure MyEventHandler()
  
  Protected MyEvent, *MyEventText
  
  MyEvent = EventData()
  *MyEventText = SendEventData(MyEvent)
  Logs(PeekS(*MyEventText))
  DispatchEvent(MyEvent, #True)
  
EndProcedure

; ***************************************************************************************

;- Part Main

Procedure Main()
  
  Protected event, style, dx, dy
  
  style = #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget
  dx = 800
  dy = 600
  
  If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, dx, dy, "Main", style)
    
    ; Menu
    ; CreateMenu(#Menu, WindowID(#Main))
    ; MenuItem(#MenuExit, "Be&enden")
    
    ; Gadgets
    ListViewGadget(#List, 0, 0, 0, 0)
    EditorGadget(#Edit, 0, 0, 0, 0)
    SplitterGadget(#Splitter, 0, 0, dx ,dy, #List, #Edit)
    SetGadgetState(#Splitter, dy * 2 / 3)
    
    ; Statusbar
    CreateStatusBar(#Status, WindowID(#Main))
    AddStatusBarField(#PB_Ignore)
    
    ; For Mac
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
      ; Enable Fullscreen
      Protected NewCollectionBehaviour
      NewCollectionBehaviour = CocoaMessage(0, WindowID(#Main), "collectionBehavior") | $80
      CocoaMessage(0, WindowID(#Main), "setCollectionBehavior:", NewCollectionBehaviour)
      ; Mac default menuÂ´s
      If Not IsMenu(#Menu)
        CreateMenu(#Menu, WindowID(#Main))
      EndIf
      MenuItem(#PB_Menu_About, "")
      MenuItem(#PB_Menu_Preferences, "")
    CompilerEndIf
    
    UpdateWindow()
    
    ; Init
    BindEvent(#My_Event_Data, @MyEventHandler())
    CreateThread(@MyThread(), 0)
    
    ; Main Loop
    Repeat
      event = WaitWindowEvent()
      Select event
        Case #PB_Event_Menu
          Select EventMenu()
            CompilerIf #PB_Compiler_OS = #PB_OS_MacOS   
              Case #PB_Menu_About
                MessageRequester("Info", "Basis v1.0")
                
              Case #PB_Menu_Preferences
                
              Case #PB_Menu_Quit
                exit = #True
                
            CompilerEndIf
              
            Case #MenuExit
              exit = #True
              
          EndSelect
          
              
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #List
              
            Case #Edit
              
          EndSelect
          
        Case #PB_Event_SizeWindow
          Select EventWindow()
            Case #Main
              UpdateWindow()
              
          EndSelect
          
        Case #PB_Event_CloseWindow
          Select EventWindow()
            Case #Main
              exit = #True
              
          EndSelect
          
      EndSelect
      
    Until exit
    
  EndIf
  
EndProcedure : Main()

End
;- BOTTOM

mk-soft · Post by **mk-soft** » Wed Oct 21, 2015 11:10 pm

Perhaps with Buffer for String?

Code: Select all

;-TOP

CompilerIf #PB_Compiler_Thread = 0
  CompilerError "Needed #PB_Compiler_Thread"
CompilerEndIf

;- Part Declare Main

Enumeration ;Window
  #Main
EndEnumeration

Enumeration ; Menu
  #Menu
EndEnumeration

Enumeration ; MenuItems
  #MenuExit
EndEnumeration
  
Enumeration ; Gadgets
  #Splitter
  #List
  #Edit
EndEnumeration

Enumeration ; Statusbar
  #Status
EndEnumeration

; Global Variable
Global exit

; ***************************************************************************************

; Functions
Procedure UpdateWindow()
  
  Protected x, y, dx, dy, menu, status
  
  menu = MenuHeight()
  If IsStatusBar(#Status)
    status = StatusBarHeight(#Status)
  Else
    status = 0
  EndIf
  x = 0
  y = 0
  dx = WindowWidth(#Main)
  dy = WindowHeight(#Main) - menu - status
  ResizeGadget(#Splitter, x, y, dx, dy)
  
EndProcedure

; ***************************************************************************************

;- Part Write Logs

Procedure MyLogs(Text.s)
  
  Protected temp.s, c
  
  temp = FormatDate("%HH.%II.%SS - ", Date())
  temp + Text
  AddGadgetItem(#List, -1, temp)
  c = CountGadgetItems(#List)
  If c > 1000
    RemoveGadgetItem(#List, 0)
    c - 1
  EndIf
  c - 1
  SetGadgetState(#List, c)
  SetGadgetState(#List, -1)
  
EndProcedure

Global MutexLogs = CreateMutex()

Macro Logs(Text)
  LockMutex(MutexLogs) : MyLogs(Text) : UnlockMutex(MutexLogs)
EndMacro

; ***************************************************************************************

;- Part Thread

Enumeration #PB_Event_FirstCustomValue
  #My_Event_Logs
EndEnumeration


Procedure MySendLogs(text.s)
  
  Static Dim buffer.s(2000)
  Static c
  
  If c > 2000
    c = 0
  EndIf
  buffer(c) = text
  PostEvent(#My_Event_Logs, 0, 0, c, @buffer(c))
  c+ 1
EndProcedure

Global MutexSendLogs = CreateMutex()

Macro SendLogs(text)
  LockMutex(MutexSendLogs) : MySendLogs(text) : UnlockMutex(MutexSendLogs)
EndMacro

; Thread
Procedure MyThread(start)
 
  Protected c, result, text.s
 
  text = "Init Thread"
  SendLogs(text)
  
  c = start
  Repeat
    text = "Counter " + Str(c)
    SendLogs(text)
    ;Debug "Result: " + Str(result)
    c + 1
    Delay(100)
  Until exit
  
  text = "Exit Thread"
  SendLogs(text)
  
EndProcedure

Procedure MyEventHandler()
  
  Protected log_id, log_text.s
  
  log_id = EventType()
  log_text = PeekS(EventData())
  Logs(Str(log_id) + ": " + log_text)
  
EndProcedure

; ***************************************************************************************

;- Part Main

Procedure Main()
  
  Protected event, style, dx, dy
  
  style = #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget
  dx = 800
  dy = 600
  
  If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, dx, dy, "Main", style)
    
    ; Menu
    ; CreateMenu(#Menu, WindowID(#Main))
    ; MenuItem(#MenuExit, "Be&enden")
    
    ; Gadgets
    ListViewGadget(#List, 0, 0, 0, 0)
    EditorGadget(#Edit, 0, 0, 0, 0)
    SplitterGadget(#Splitter, 0, 0, dx ,dy, #List, #Edit)
    SetGadgetState(#Splitter, dy * 2 / 3)
    
    ; Statusbar
    CreateStatusBar(#Status, WindowID(#Main))
    AddStatusBarField(#PB_Ignore)
    
    ; For Mac
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
      ; Enable Fullscreen
      Protected NewCollectionBehaviour
      NewCollectionBehaviour = CocoaMessage(0, WindowID(#Main), "collectionBehavior") | $80
      CocoaMessage(0, WindowID(#Main), "setCollectionBehavior:", NewCollectionBehaviour)
      ; Mac default menuÂ´s
      If Not IsMenu(#Menu)
        CreateMenu(#Menu, WindowID(#Main))
      EndIf
      MenuItem(#PB_Menu_About, "")
      MenuItem(#PB_Menu_Preferences, "")
    CompilerEndIf
    
    UpdateWindow()
    
    ; Init
    BindEvent(#My_Event_Logs, @MyEventHandler())
    CreateThread(@MyThread(), 10000)
    CreateThread(@MyThread(), 20000)
    CreateThread(@MyThread(), 30000)
    CreateThread(@MyThread(), 40000)
    
    ; Main Loop
    Repeat
      event = WaitWindowEvent()
      Select event
        Case #PB_Event_Menu
          Select EventMenu()
            CompilerIf #PB_Compiler_OS = #PB_OS_MacOS   
              Case #PB_Menu_About
                MessageRequester("Info", "Basis v1.0")
                
              Case #PB_Menu_Preferences
                
              Case #PB_Menu_Quit
                exit = #True
                
            CompilerEndIf
              
            Case #MenuExit
              exit = #True
              
          EndSelect
          
              
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #List
              
            Case #Edit
              
          EndSelect
          
        Case #PB_Event_SizeWindow
          Select EventWindow()
            Case #Main
              UpdateWindow()
              
          EndSelect
          
        Case #PB_Event_CloseWindow
          Select EventWindow()
            Case #Main
              exit = #True
              
          EndSelect
          
      EndSelect
      
    Until exit
    
  EndIf
  
EndProcedure : Main()

End
;- BOTTOM

wilbert · Post by **wilbert** » Thu Oct 22, 2015 8:06 am

Have you tried handling all events (including the main event loop) with a BindEvent callback ?

mk-soft · Post by **mk-soft** » Thu Oct 22, 2015 11:02 pm

Testet with bind all events. The logging output always blocking on Menu an Resize.
At time no problem, because my module buffering the LogEvents.

But the output on ListIconGadget are very slow. ListViewGadget works fast.
SetGadgetItemColor don´t work on Mac

Modul Logging

Code: Select all

;-TOP

; ***************************************************************************************

; Comment : Modul Logging
; Author  : mk-soft
; Version : v1.00

; ***************************************************************************************

CompilerIf #PB_Compiler_Thread = 0
  CompilerError "Missing Threadsafe"
CompilerEndIf

DeclareModule Logging
  
  ; Constants
  Enumeration
    #LogEvent_Default
    #LogEvent_Ok
    #LogEvent_Warn
    #LogEvent_Alarm
  EndEnumeration
  
  ; Functions
  Declare InitLogging(GadgetID, MaxList = 1000, EventID = #PB_Event_FirstCustomValue, MaxBuffer = 1000)
  Declare ReleaseLogging()
  Declare LogEvent(Id, Type, Text.s)
  
EndDeclareModule

; ***************************************************************************************

Module Logging
  
  EnableExplicit
  
  #LogColor_Default = $FFF8F8
  #LogColor_Ok = $32CD32
  #LogColor_Warn = $00D7FF
  #LogColor_Alarm = $0045FF
  
  Structure udtLogs
    timestamp.i
    id.i
    type.i
    text.s
  EndStructure
  
  ; -----------------------------------------------------------------------------------
  
  Declare EventHandlerListIcon()
  Declare EventHandlerListView()
  
  ; -----------------------------------------------------------------------------------
  
  Global Dim buffer.udtLogs(0)
  Global g_mutex, g_type, g_init
  Global g_gadget, g_maxlist, g_event, g_maxbuffer
  
  ; -----------------------------------------------------------------------------------
  
  Procedure InitLogging(GadgetID, MaxList = 1000, EventID = #PB_Event_FirstCustomValue, MaxBuffer = 1000)
    
    g_gadget = GadgetID
    If IsGadget(g_gadget) = 0
      ProcedureReturn #False
    EndIf
    
    g_type = GadgetType(GadgetID)
    If g_type <> #PB_GadgetType_ListIcon And g_type <> #PB_GadgetType_ListView
      ProcedureReturn #False
    EndIf
    
    g_maxbuffer = MaxBuffer
    If g_maxbuffer < g_maxlist
      g_maxbuffer = g_maxlist
    EndIf
    Global Dim buffer(g_maxbuffer)
    
    If ArraySize(buffer()) <> g_maxbuffer
      ProcedureReturn #False
    EndIf
    
    g_mutex = CreateMutex()
    If g_mutex = 0
      ProcedureReturn #False
    EndIf
    
    g_event = EventID
    If g_type = #PB_GadgetType_ListIcon
      BindEvent(g_event, @EventHandlerListIcon())
    Else
      BindEvent(g_event, @EventHandlerListView())
    EndIf
    
    g_maxlist = MaxList
    g_init = #True
    
    ProcedureReturn #True
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure ReleaseLogging()
    If g_init
      g_init = #False
      If g_type = #PB_GadgetType_ListIcon
        UnbindEvent(g_event, @EventHandlerListIcon())
      Else
        UnbindEvent(g_event, @EventHandlerListView())
      EndIf
    EndIf
                  
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure LogEvent(Id, Type, Text.s)
    
    Static c
    
    LockMutex(g_mutex)
    
    If c > g_maxbuffer
      c = 0
    EndIf
    
    With buffer(c)
      \timestamp = Date()
      \id = id
      \type = type
      \text = text
    EndWith
    If g_init
      PostEvent(g_event, 0, 0, 0, @buffer(c))
    EndIf
    c + 1
    
    UnlockMutex(g_mutex)
    
  EndProcedure
    
  ; -----------------------------------------------------------------------------------
  
  Procedure EventHandlerListIcon()
    
    Protected *buffer.udtLogs, sTemp.s, c
    
    *buffer = EventData()
    If *buffer
      With *buffer
        sTemp = FormatDate("%YYYY/%MM/%DD %HH.%II.%SS", \timestamp)
        sTemp + #LF$ + Str(\id)
        Select \type
          Case #LogEvent_Default
            sTemp + #LF$ + "Info"
          Case #LogEvent_Ok
            sTemp + #LF$ + "Ok"
          Case #LogEvent_Warn
            sTemp + #LF$ + "Warn"
          Case #LogEvent_Alarm
            sTemp + #LF$ + "Alarm"
          Default
            sTemp + #LF$ + "Other"
        EndSelect
        sTemp + #LF$ + \text
        AddGadgetItem(g_gadget, -1, sTemp)
        
        c = CountGadgetItems(g_gadget)
        If c > g_maxlist
          RemoveGadgetItem(g_gadget, 0)
          c - 1
        EndIf
        c - 1
        
        CompilerIf #PB_Compiler_OS <> #PB_OS_MacOS
          Select \type
            Case #LogEvent_Default
              SetGadgetItemColor(g_gadget, c, #PB_Gadget_BackColor, #LogColor_Default)
            Case #LogEvent_Ok
              SetGadgetItemColor(g_gadget, c, #PB_Gadget_BackColor, #LogColor_Ok)
            Case #LogEvent_Warn
              SetGadgetItemColor(g_gadget, c, #PB_Gadget_BackColor, #LogColor_Warn)
            Case #LogEvent_Alarm
              SetGadgetItemColor(g_gadget, c, #PB_Gadget_BackColor, #LogColor_Alarm)
          EndSelect
        CompilerEndIf
      
        SetGadgetState(g_gadget, c)
        SetGadgetState(g_gadget, -1)
      EndWith
      
    EndIf
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure EventHandlerListView()
    
    Protected *buffer.udtLogs, sTemp.s, c
    
    *buffer = EventData()
    If *buffer
      With *buffer
        sTemp = FormatDate("%YYYY/%MM/%DD %HH.%II.%SS;", \timestamp)
        sTemp + Str(\id) + ";"
        Select \type
          Case #LogEvent_Default
            sTemp + "Info;"
          Case #LogEvent_Ok
            sTemp + "Ok;"
          Case #LogEvent_Warn
            sTemp + "Warn;"
          Case #LogEvent_Alarm
            sTemp + "Alarm;"
          Default
            sTemp + "Other;"
        EndSelect
        sTemp + \text
        AddGadgetItem(g_gadget, -1, sTemp)
        c = CountGadgetItems(g_gadget)
        If c > g_maxlist
          RemoveGadgetItem(g_gadget, 0)
          c - 1
        EndIf
        c - 1
        SetGadgetState(g_gadget, c)
        SetGadgetState(g_gadget, -1)
      EndWith
      
    EndIf
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
EndModule

;- END

; ***************************************************************************************

ListView

Code: Select all


IncludeFile "Modul_Logging.pb"

UseModule Logging
  
;- Part Declare Main

Enumeration ;Window
  #Main
EndEnumeration

Enumeration ; Menu
  #Menu
EndEnumeration

Enumeration ; MenuItems
  #MenuExit
EndEnumeration
  
Enumeration ; Gadgets
  #Splitter
  #List
  #Edit
EndEnumeration

Enumeration ; Statusbar
  #Status
EndEnumeration

; Global Variable
Global exit

; ***************************************************************************************

; Functions
Procedure UpdateWindow()
  
  Protected x, y, dx, dy, menu, status
  
  menu = MenuHeight()
  If IsStatusBar(#Status)
    status = StatusBarHeight(#Status)
  Else
    status = 0
  EndIf
  x = 0
  y = 0
  dx = WindowWidth(#Main)
  dy = WindowHeight(#Main) - menu - status
  ResizeGadget(#Splitter, x, y, dx, dy)
  
EndProcedure

; ***************************************************************************************

; Thread
Procedure MyThread(start)
 
  Protected c, result, text.s
 
  text = "Init Thread"
  LogEvent(start, 0, text)
  
  c = start
  Repeat
    text = "Counter " + Str(c)
    LogEvent(c, Random(4), text)
    c + 1
    Delay(100)
  Until exit
  
  text = "Exit Thread"
  LogEvent(start, 0, text)
  
EndProcedure

; ***************************************************************************************

;- Part Main

Procedure EventHandler()
  ;
EndProcedure

Procedure Main()
  
  Protected event, style, dx, dy
  
  style = #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget
  dx = 800
  dy = 600
  
  If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, dx, dy, "Main", style)
    
    ; Menu
    ; CreateMenu(#Menu, WindowID(#Main))
    ; MenuItem(#MenuExit, "Be&enden")
    
    ; Gadgets
    ListViewGadget(#List, 0, 0, 0, 0)
    EditorGadget(#Edit, 0, 0, 0, 0)
    SplitterGadget(#Splitter, 0, 0, dx ,dy, #List, #Edit)
    SetGadgetState(#Splitter, dy * 2 / 3)
    
    ; Statusbar
    CreateStatusBar(#Status, WindowID(#Main))
    AddStatusBarField(#PB_Ignore)
    
    ; For Mac
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
      ; Enable Fullscreen
      Protected NewCollectionBehaviour
      NewCollectionBehaviour = CocoaMessage(0, WindowID(#Main), "collectionBehavior") | $80
      CocoaMessage(0, WindowID(#Main), "setCollectionBehavior:", NewCollectionBehaviour)
      ; Mac default menuÂ´s
      If Not IsMenu(#Menu)
        CreateMenu(#Menu, WindowID(#Main))
      EndIf
      MenuItem(#PB_Menu_About, "")
      MenuItem(#PB_Menu_Preferences, "")
    CompilerEndIf
    
    UpdateWindow()
    
    BindEvent(#PB_Event_SizeWindow, @UpdateWindow())
    ; Test
    BindEvent(#PB_Event_ActivateWindow, @EventHandler())
    BindEvent(#PB_Event_CloseWindow, @EventHandler())
    BindEvent(#PB_Event_DeactivateWindow, @EventHandler())
    BindEvent(#PB_Event_Gadget, @EventHandler())
    BindEvent(#PB_Event_LeftClick, @EventHandler())
    BindEvent(#PB_Event_LeftDoubleClick, @EventHandler())
    BindEvent(#PB_Event_MaximizeWindow, @EventHandler())
    BindEvent(#PB_Event_Menu, @EventHandler())
    BindEvent(#PB_Event_MinimizeWindow, @EventHandler())
    BindEvent(#PB_Event_MoveWindow, @EventHandler())
    BindEvent(#PB_Event_None, @EventHandler())
    BindEvent(#PB_Event_Repaint, @EventHandler())
    BindEvent(#PB_Event_RestoreWindow, @EventHandler())
    BindEvent(#PB_Event_RightClick, @EventHandler())
    BindEvent(#PB_Event_SysTray, @EventHandler())
    BindEvent(#PB_Event_Timer, @EventHandler())
    
    ; Init
    InitLogging(#List, 5000)
    CreateThread(@MyThread(), 10000)
    CreateThread(@MyThread(), 20000)
    CreateThread(@MyThread(), 30000)
    CreateThread(@MyThread(), 40000)
    
    ; Main Loop
    Repeat
      event = WaitWindowEvent()
      Select event
        Case #PB_Event_Menu
          Select EventMenu()
            CompilerIf #PB_Compiler_OS = #PB_OS_MacOS   
              Case #PB_Menu_About
                MessageRequester("Info", "Testing of Modul Logging")
                
              Case #PB_Menu_Preferences
                
              Case #PB_Menu_Quit
                exit = #True
                
            CompilerEndIf
              
            Case #MenuExit
              exit = #True
              
          EndSelect
          
              
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #List
              
            Case #Edit
              
          EndSelect
          
        Case #PB_Event_SizeWindow
          Select EventWindow()
            Case #Main
              ;UpdateWindow()
              
          EndSelect
          
        Case #PB_Event_CloseWindow
          Select EventWindow()
            Case #Main
              exit = #True
              
          EndSelect
          
      EndSelect
      
    Until exit
    ReleaseLogging()
    Delay(2000)
    While WindowEvent() : Wend
    
  EndIf
  
EndProcedure : Main()

End

ListIcon

Code: Select all


IncludeFile "Modul_Logging.pb"

UseModule Logging

;- Part Declare Main

Enumeration ;Window
  #Main
EndEnumeration

Enumeration ; Menu
  #Menu
EndEnumeration

Enumeration ; MenuItems
  #MenuExit
  #MenuStart
  #MenuStop
EndEnumeration

Enumeration ; Gadgets
  #Splitter
  #List
  #Edit
EndEnumeration

Enumeration ; Statusbar
  #Status
EndEnumeration

; Global Variable
Global exit, stop

; ***************************************************************************************

; Functions
Procedure UpdateWindow()
  
  Protected x, y, dx, dy, menu, status
  
  menu = MenuHeight()
  If IsStatusBar(#Status)
    status = StatusBarHeight(#Status)
  Else
    status = 0
  EndIf
  x = 0
  y = 0
  dx = WindowWidth(#Main)
  dy = WindowHeight(#Main) - menu - status
  ResizeGadget(#Splitter, x, y, dx, dy)
  
EndProcedure

; ***************************************************************************************

; Thread
Procedure MyThread(start)
  
  Protected c, result, text.s, time, type
  
  text = "Init Thread"
  LogEvent(start, 0, text)
  
  c = start
  Repeat
    type = Random(3)
    text = "Counter " + Str(c)
    LogEvent(c, type, text)
    c + 1
    time = Random(1000, 200)
    Delay(time)
  Until stop
  
  text = "Exit Thread"
  LogEvent(start, 0, text)
  
EndProcedure

; ***************************************************************************************

;- Part Main

Procedure Main()
  
  Protected event, style, dx, dy
  
  style = #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget
  dx = 800
  dy = 600
  
  If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, dx, dy, "Main", style)
    
    ; Menu
    CreateMenu(#Menu, WindowID(#Main))
    MenuTitle("&File")
    MenuItem(#MenuStart, "&Start")
    MenuItem(#MenuStop, "Sto&p")
    MenuBar()
    MenuItem(#MenuExit, "E&xit")
    
    ; Gadgets
    ListIconGadget(#List, 0, 0, 0, 0, "Date", 150)
    AddGadgetColumn(#List, 1, "Id", 50)
    AddGadgetColumn(#List, 2, "Type", 50)
    AddGadgetColumn(#List, 3, "Text", 500)
    
    EditorGadget(#Edit, 0, 0, 0, 0)
    SplitterGadget(#Splitter, 0, 0, dx ,dy, #List, #Edit)
    SetGadgetState(#Splitter, dy * 2 / 3)
    
    ; Statusbar
    CreateStatusBar(#Status, WindowID(#Main))
    AddStatusBarField(#PB_Ignore)
    
    ; For Mac
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
      ; Enable Fullscreen
      Protected NewCollectionBehaviour
      NewCollectionBehaviour = CocoaMessage(0, WindowID(#Main), "collectionBehavior") | $80
      CocoaMessage(0, WindowID(#Main), "setCollectionBehavior:", NewCollectionBehaviour)
      ; Mac default menuÂ´s
      If Not IsMenu(#Menu)
        CreateMenu(#Menu, WindowID(#Main))
      EndIf
      MenuItem(#PB_Menu_About, "")
      MenuItem(#PB_Menu_Preferences, "")
    CompilerEndIf
    
    UpdateWindow()
    
    ; Init
    InitLogging(#List)
    CreateThread(@MyThread(), 10000)
    CreateThread(@MyThread(), 20000)
    CreateThread(@MyThread(), 30000)
    CreateThread(@MyThread(), 40000)
    ;CreateThread(@MyThread(), 50000)
    ;CreateThread(@MyThread(), 60000)
    ;CreateThread(@MyThread(), 70000)
    ;CreateThread(@MyThread(), 80000)
    
    ; Main Loop
    Repeat
      event = WaitWindowEvent()
      Select event
        Case #PB_Event_Menu
          Select EventMenu()
            CompilerIf #PB_Compiler_OS = #PB_OS_MacOS   
              Case #PB_Menu_About
                MessageRequester("Info", "Testing of Modul Logging")
                
              Case #PB_Menu_Preferences
                
              Case #PB_Menu_Quit
                exit = #True
                
            CompilerEndIf
              
            Case #MenuExit
              exit = #True
              
            Case #MenuStart
              If stop
                CreateThread(@MyThread(), 10000)
                CreateThread(@MyThread(), 20000)
                CreateThread(@MyThread(), 30000)
                CreateThread(@MyThread(), 40000)
                stop = 0
              EndIf
            Case #MenuStop
              stop = 1
              
          EndSelect
          
          
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #List
              
            Case #Edit
              
          EndSelect
          
        Case #PB_Event_SizeWindow
          Select EventWindow()
            Case #Main
              UpdateWindow()
              
          EndSelect
          
        Case #PB_Event_CloseWindow
          Select EventWindow()
            Case #Main
              exit = #True
              
          EndSelect
          
      EndSelect
      
      If stop = 0 And exit
        MessageRequester("Info", "Stopping first")
        exit = 0
      EndIf
      
    Until exit
    
  EndIf
  
EndProcedure : Main()

End

PureBasic Forums - English

How to create unblocked Events

How to create unblocked Events

Re: How to create unblocked Events

Re: How to create unblocked Events

Re: How to create unblocked Events