SendEvent Include (ab PB v5.10)

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
mk-soft
Beiträge: 3844
Registriert: 24.11.2004 13:12
Wohnort: Germany

SendEvent Include (ab PB v5.10)

Beitrag von mk-soft »

Manchmal braucht man eine Anwort von User wie es in einen Thread weitergehen soll.
Dafür habe ich aus den PostEvent ein SendEvent erstellt.

Update v1.05
- Optionaler Parameter für externen Semaphore für bessere Performans

Update v1.04
- Beispiel überarbeitet

Update v1.03
- #PB_Event_FirstCustomValue

Update v1.02
- Eigenen EventType übergeben

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
FF :wink:
Zuletzt geändert von mk-soft am 23.01.2013 12:58, insgesamt 7-mal geändert.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 7028
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Re: Aus PostEvent ein SendEvent

Beitrag von STARGÅTE »

Wird sicherlich funktionieren ^^, allerdings sollten wir noch warten bis die nächte Beta kommt, denn aktuell erzeugt PostEvent() ein "procedure stack has been currupted" (unter x86).
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Benutzeravatar
mk-soft
Beiträge: 3844
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Aus PostEvent ein SendEvent

Beitrag von mk-soft »

Ich warte auch schon auf die nächste Beta :allright:
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3844
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Aus PostEvent ein SendEvent

Beitrag von mk-soft »

Läuft ab PB v5.10 Beta 2 :allright:
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3844
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: SendEvent Include (ab PB v5.10)

Beitrag von mk-soft »

Update v1.05
- Optionaler Parameter für externen Semaphore für bessere Performans

FF :wink:
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Antworten