Alles was mit PostEvent(...) versendet wird läuft im Message-Buffer von PB auf und wird erst beim Aufruf von WaitWindowEvent(...) verarbeitet.
Code: Alles auswählen
;-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
EnableExplicit
; Constant
Enumeration ;Window
#Main
EndEnumeration
Enumeration ; Menu
#Menu
EndEnumeration
Enumeration ; MenuItems
#MenuExitApplication
EndEnumeration
Enumeration ; Gadgets
#List
#Edit
EndEnumeration
Enumeration ; Statusbar
#Status
EndEnumeration
; Global Variable
Global ExitApplication
; 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(#List, x, y, dx, dy)
EndProcedure
; -----------------------------------------------------------------------------
Enumeration EventCustomValue #PB_Event_FirstCustomValue
#MyEvent_GetClipbord
#MyEvent_SetClipboard
#MyEvent_AddText
EndEnumeration
Procedure DoSetClipboard()
Protected MyEvent, *text.String
MyEvent = EventData()
*text = SendEventData(MyEvent)
SetClipboardText(*text\s)
DispatchEvent(MyEvent, 1)
EndProcedure
Procedure DoGetClipboard()
Protected MyEvent, *text.String, len
MyEvent = EventData()
*text = SendEventData(MyEvent)
*text\s = GetClipboardText()
len = Len(*text\s)
If len
ClearClipboard()
EndIf
DispatchEvent(MyEvent, len)
EndProcedure
Procedure DoAddText()
Protected MyEvent, *text.String
MyEvent = EventData()
*text = SendEventData(MyEvent)
AddGadgetItem(#List, -1, *text\s)
DispatchEvent(MyEvent, 1)
EndProcedure
BindEvent(#MyEvent_GetClipbord, @DoGetClipboard())
BindEvent(#MyEvent_SetClipboard, @DoSetClipboard())
BindEvent(#MyEvent_AddText, @DoAddText())
; -----------------------------------------------------------------------------
Structure udtThread
ThreadID.i
Exit.i
EndStructure
Global Thread1.udtThread
Procedure thWork(*data.udtThread)
Protected result, text.string
Repeat
result = SendEvent(#MyEvent_GetClipbord, 0, 0, 0, text)
If result
SendEvent(#MyEvent_AddText, 0, 0, 0, text)
EndIf
Delay(1000)
Until *data\Exit
EndProcedure
; -----------------------------------------------------------------------------
; 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)
; Enable Fullscreen
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
Protected NewCollectionBehaviour
NewCollectionBehaviour = CocoaMessage(0, WindowID(#Main), "collectionBehavior") | $80
CocoaMessage(0, WindowID(#Main), "setCollectionBehavior:", NewCollectionBehaviour)
CompilerEndIf
; Menu
CreateMenu(#Menu, WindowID(#Main))
MenuTitle("Ablage")
MenuItem(#MenuExitApplication, "Be&enden")
; Gadgets
ListViewGadget(#List, 0, 0, dx, dy)
; Statusbar
CreateStatusBar(#Status, WindowID(#Main))
AddStatusBarField(#PB_Ignore)
UpdateWindow()
Thread1\ThreadID = CreateThread(@thWork(), thread1)
; Main Loop
Repeat
event = WaitWindowEvent()
Select event
Case #PB_Event_Menu
Select EventMenu()
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
Case #PB_Menu_About
Case #PB_Menu_Preferences
Case #PB_Menu_Quit
ExitApplication = #True
CompilerEndIf
Case #MenuExitApplication
ExitApplication = #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
ExitApplication = #True
EndSelect
EndSelect
Until ExitApplication
; Warten das der Thread beendet ist
Thread1\Exit = #True
Repeat
WaitWindowEvent(100)
If IsThread(Thread1\ThreadID) = 0
Break
EndIf
ForEver
EndIf
EndProcedure : Main()
End