SendEvent - PostEvent from threads with waiting on result

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

SendEvent - PostEvent from threads with waiting on result

Post by mk-soft »

Sometimes a thread needs a user input and has to wait at this point.
As for I have written from the PostEvent a SendEvent with result.

Runs a bit longer in my projects.

Code: Select all

;-TOP

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

;-Begin Of SendEvent

; Comment : SendEvent
; Author  : mk-soft
; Version : v1.06
; Create  : unknown
; Update  : 07.08.2016

;- 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

;- End Of SendEvent

; ***************************************************************************************
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5393
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: SendEvent - PostEvent from threads with waiting on resul

Post by mk-soft »

Example

Code: Select all

CompilerIf #PB_Compiler_IsMainFile
  
  EnableExplicit
  
  ; ***************************************************************************************
  
  ;- Memory string helper
  
  Procedure AllocateString(String.s)
    Protected *mem.string
    *mem = AllocateStructure(string)
    If *mem
      *mem\s = String
    EndIf
    ProcedureReturn *mem
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure.s FreeString(*mem.string)
    Protected result.s
    If *mem
      result = *mem\s
      FreeStructure(*mem)
    EndIf
    ProcedureReturn result
  EndProcedure
  
  ; ***************************************************************************************

  Enumeration
    #Window
  EndEnumeration
  
  ;- Constants
  Enumeration #PB_Event_FirstCustomValue
    #My_Event_Messagebox
    #My_Event_Inputbox
  EndEnumeration
  
  Procedure Thread1(Null)
    
    Debug "Init Thread 1"
    Protected result
    
    Repeat
      Delay(500)
      result = SendEvent(#My_Event_Messagebox, 0, 0, 0, Random(100))
      Select result
        Case #PB_MessageRequester_Yes
          Debug "#PB_MessageRequester_Yes"
        Case #PB_MessageRequester_No
          Debug "#PB_MessageRequester_No"
        Case #PB_MessageRequester_Cancel
          Debug "#PB_MessageRequester_Cancel"
      EndSelect
    Until result = #PB_MessageRequester_Cancel
    
    Debug "Exit Thread 1"
    
  EndProcedure
  
  Procedure Thread2(Null)
    
    Debug "Init Thread 2"
    Protected result, text.s
    
    Repeat
      Delay(500)
      result = SendEvent(#My_Event_Inputbox, 0, 0, 0, Random(100))
      text = FreeString(result)
      Debug text
    Until text = ""
    
    Debug "Exit Thread 2"
    
  EndProcedure
  
  Procedure Main()
    Protected exit, th1, th2
    Protected MyEvent, value, result, text.s 
    
    If OpenWindow(#Window, 0, 0, 800, 600, "WindowTitle", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
      th1 = CreateThread(@Thread1(), #Null)
      Repeat
        Select WaitWindowEvent()
          Case #PB_Event_CloseWindow
            Break
            
          Case #PB_Event_Gadget
            
          Case #My_Event_Messagebox
            MyEvent = EventData()
            value = SendEventData(MyEvent)
            result = MessageRequester("Thread 1", "What happens next?" + #LF$ + "(Code " + value + ")", #PB_MessageRequester_YesNoCancel)
            DispatchEvent(MyEvent, result)
            If result = #PB_MessageRequester_Cancel
              th2 = CreateThread(@Thread2(), #Null)
            EndIf
            
          Case #My_Event_Inputbox
            MyEvent = EventData()
            text = InputRequester("Thread 2", "Name:", "")
            result = AllocateString(text)
            DispatchEvent(MyEvent, result)
            
        EndSelect
      ForEver
      
      If IsThread(th1)
        KillThread(th1)
      EndIf
      If IsThread(th2)
        KillThread(th2)
      EndIf
      
    EndIf
  EndProcedure : Main()
  
CompilerEndIf
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Post Reply