PureBoard

Code: Alles auswählen

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

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

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

Enumeration
   #Window
EndEnumeration

;- Test

;- Constants
Enumeration #PB_Event_FirstCustomValue
  #My_Event_Question
EndEnumeration

Procedure Test(Null)
 
  Protected result
  
  Debug "Init Thread"
  MySemaphore = CreateSemaphore()
  
  Repeat
    Delay(500)
    result = SendEvent(#My_Event_Question, 0, 0, 0, Random(100), MySemaphore)
    Select result
      Case #PB_MessageRequester_Yes
        Debug "Antwort Ja"
      Case #PB_MessageRequester_No
        Debug "Antwort Nein"
      Case #PB_MessageRequester_Cancel
        Debug "Antwort Abbrechen"
    EndSelect
  Until result = #PB_MessageRequester_Cancel
  
  If MySemaphore
    FreeSemaphore(MySemaphore)
  EndIf
  
  Debug "Exit Thread"
  
EndProcedure

Global MyEvent

If OpenWindow(#Window, 0, 0, 800, 600, "WindowTitle", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
 
  hThread = CreateThread(@Test(), #Null)
 
  Repeat
     
    Select WaitWindowEvent()
           
        Case #PB_Event_CloseWindow
           exit = 1
           
        Case #PB_Event_Gadget
         
        Case #My_Event_Question
           MyEvent = EventData()
           Value = SendEventData(MyEvent)
           Debug "Es kommt ein SendEvent: " + Str(Value)
           result = MessageRequester("Frage", "Wie soll es weiter gehen?", #PB_MessageRequester_YesNoCancel)
           DispatchEvent(MyEvent, result)
       
     EndSelect
     
   Until exit
   If IsThread(hThread)
     Debug "Thread läuft"
     KillThread(hThread)
   EndIf
   
 EndIf