Here now an example with...
- Helpfunction SendEvent(...)
- MessageRequester with Timeout
- Thread with open MessageRequester
Works with all OS, because all Windows and Gadgets functions call inside Mainscope
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
; ***************************************************************************************
;- Example
CompilerIf #PB_Compiler_IsMainFile
EnableExplicit
; ***************************************************************************************
Procedure MyMessageRequester(Parent, Title.s, Text.s, Flags=#PB_MessageRequester_Ok, Timeout=0)
Protected Result, Dialog, Info, Button1, Button2, Button3, Time
Dialog = OpenWindow(#PB_Any, 0, 0, 500, 100, Title, #PB_Window_WindowCentered, Parent)
If Dialog
DisableWindow(Parent, 1)
StickyWindow(Dialog, #True)
TextGadget(#PB_Any, 10, 10, 480, 50, Text, #PB_Text_Center)
Select Flags
Case #PB_MessageRequester_Ok
Button1 = ButtonGadget(#PB_Any, 200, 70, 100, 25, "Ok")
Case #PB_MessageRequester_YesNo
Button1 = ButtonGadget(#PB_Any, 150, 70, 100, 25, "Yes")
Button2 = ButtonGadget(#PB_Any, 260, 70,100, 25, "No")
Case #PB_MessageRequester_YesNoCancel
Button1 = ButtonGadget(#PB_Any, 90, 70, 100, 25, "Yes")
Button2 = ButtonGadget(#PB_Any, 200, 70, 100, 25, "No")
Button3 = ButtonGadget(#PB_Any, 310, 70, 100, 25, "Cancel")
EndSelect
If Timeout
Time = ElapsedMilliseconds()
EndIf
Repeat
Select WaitWindowEvent(100)
Case #PB_Event_Gadget
Select EventGadget()
Case Button1
Result = #PB_MessageRequester_Yes
Break
Case Button2
Result = #PB_MessageRequester_No
Break
Case Button3
Result = #PB_MessageRequester_Cancel
Break
EndSelect
Default
If Timeout
If ElapsedMilliseconds() - Time > Timeout
Result = -1
Break
EndIf
EndIf
EndSelect
ForEver
DisableWindow(Parent, 0)
CloseWindow(Dialog)
ProcedureReturn Result
EndIf
EndProcedure
;- 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"
Case -1
Debug "MessageRequester Timeout"
EndSelect
Until result = #PB_MessageRequester_Cancel Or result = -1
Debug "Exit Thread 1"
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 = MyMessageRequester(#Window, "Thread 1", "What happens next? (Timeout: 20000ms)" + #LF$ + "(Code " + value + ")", #PB_MessageRequester_YesNoCancel, 20000)
DispatchEvent(MyEvent, result)
EndSelect
ForEver
If IsThread(th1)
KillThread(th1)
EndIf
If IsThread(th2)
KillThread(th2)
EndIf
EndIf
EndProcedure : Main()
CompilerEndIf