durch ts-soft und seine CopyFileEx-Include bin ich auf die Idee gekommen ein einfaches Message-System für andere Betriebssystem als Windows zu programmieren.
Leider konnte ich noch nicht testen, ob es unter Windows genau so läuft wie unter Linux.
Ich habe versucht die Funktionalität von SendMessage_() und PostMessage_() unter Windows nachzuahmen und auch einen Callback zu ermöglichen. Somit kann man auch aus einem Thread heraus Messages in die Event-Queue eines Fensters pushen.
Message\sendMessage() sendet eine Nachricht an das Fenster und kehrt erst dann wieder zurück, wenn Message\wait() die Nachricht abgearbeitet hat. Dabei kann der Callback den Rückgabewert bestimmen. Message\postMessage() schickt hingegen eine Nachricht ohne auf die Abarbeitung zu warten. Ein bisschen unglücklich bin ich noch mit der Implementierung von Message\wait(), aber hauptsache es funktioniert. Außerdem hat die Angabe des Windowhandles bei Message\setCallback() noch keine Auswirkung. Aber das ist ja eine Sache, die sich schnell noch einbauen lässt, wenn man möchte.
Geschützt ist das ganze System durch Locks und Semaphoren, damit einer Multithreading-Anwendung nichts im Wege steht.
Viel Spaß damit, und wenn noch weitere Beispiele erwünscht sind, dann gebt Bescheid.
///Edit 1:
Jetzt funktioniert Message\setCallback() so wie er soll.
///Edit 2 vom 04.05.2010 15:28:
Jetzt sollte es auch unter Windows funktionieren.
///Edit 3 vom 04.05.2010 18:57:
Message\gadget() wieder entfernt, weil es unnötig war.
Zunächst die Include 'Message.pbi'
Code: Alles auswählen
Prototype.i MessageCallback(hwnd.i, msg.i, wParam.i, lParam.i)
Interface Message
sendMessage.i(hwnd.i, msg.i, wParam.i, lParam.i) ;with waiting
postMessage(hwnd.i, msg.i, wParam.i, lParam.i) ;without waiting
wait.i(timeout.i = 0)
hWindow.i()
lParam.i()
wParam.i()
setCallback(hwnd.i, *callback.MessageCallback)
EndInterface
Structure MessageElement
hwnd.i
msg.i
wParam.i
lParam.i
*result.Integer
EndStructure
Structure MessageCallbackS
hwnd.i
*callback.MessageCallback
EndStructure
Structure MessageS
vTable.i
hLock.i
hSemaphore.i
List queue.MessageElement()
hLockCallback.i
List callbacks.MessageCallbackS()
hWindow.i
lParam.i
wParam.i
EndStructure
Procedure Message_new()
Protected *this.MessageS
*this = AllocateMemory(SizeOf(MessageS))
If Not *this : ProcedureReturn #False : EndIf
InitializeStructure(*this, MessageS)
With *this
\vTable = ?vTable_Message
\hlock = CreateMutex()
\hSemaphore = CreateSemaphore(0)
\hLockCallback = CreateMutex()
EndWith
ProcedureReturn *this
EndProcedure
Procedure.i Message_sendMessage(*this.MessageS, hwnd.i, msg.i, wParam.i, lParam.i)
Protected result.i, *result.Integer
With *this
LockMutex(\hLock)
If AddElement(\queue())
\queue()\hwnd = hwnd
\queue()\msg = msg
\queue()\wParam = wParam
\queue()\lParam = lParam
\queue()\result = AllocateMemory(SizeOf(Integer))
\queue()\result\i = 1
*result = \queue()\result
UnlockMutex(\hLock)
WaitSemaphore(\hSemaphore)
result = *result\i
FreeMemory(*result)
Else
UnlockMutex(\hLock)
EndIf
EndWith
ProcedureReturn result
EndProcedure
Procedure Message_postMessage(*this.MessageS, hwnd.i, msg.i, wParam.i, lParam.i)
Protected result.i
With *this
LockMutex(\hLock)
If AddElement(\queue())
\queue()\hwnd = hwnd
\queue()\msg = msg
\queue()\wParam = wParam
\queue()\lParam = lParam
\queue()\result = 0
result = 0
Else
result = 1
EndIf
UnlockMutex(\hLock)
EndWith
ProcedureReturn result
EndProcedure
Procedure.i Message_getCallback(*this.MessageS, hwnd.i)
With *this
LockMutex(\hLockCallback)
ForEach \callbacks()
If \callbacks()\hwnd = hwnd
UnlockMutex(\hLockCallback)
ProcedureReturn \callbacks()
EndIf
Next
UnlockMutex(\hLockCallback)
EndWith
ProcedureReturn 0
EndProcedure
Procedure.i Message_wait(*this.MessageS, timeout.i = 0)
Protected result.i, signal.i, endTime.i = ElapsedMilliseconds() + timeout
Protected *callback.MessageCallbackS
With *this
Repeat
LockMutex(\hLock)
If FirstElement(\queue())
signal = \queue()\result
If signal
*callback = Message_getCallback(*this, \queue()\hwnd)
If *callback
\queue()\result\i = *callback\callback(\queue()\hwnd, \queue()\msg, \queue()\wParam, \queue()\lParam)
Else
\queue()\result\i = 0
EndIf
Else
*callback = Message_getCallback(*this, \queue()\hwnd)
If *callback
*callback\callback(\queue()\hwnd, \queue()\msg, \queue()\wParam, \queue()\lParam)
EndIf
EndIf
\wParam = \queue()\wParam
\lParam = \queue()\lParam
\hWindow = \queue()\hwnd
result = \queue()\msg
If signal
SignalSemaphore(\hSemaphore)
EndIf
DeleteElement(\queue())
UnlockMutex(\hLock)
Break
Else
UnlockMutex(\hLock)
result = WaitWindowEvent(10)
If result
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
\lParam = EventlParam()
\wParam = EventwParam()
CompilerElse
\lParam = 0
\wParam = 0
CompilerEndIf
\hWindow = EventWindow()
If IsWindow(\hWindow)
\hWindow = WindowID(\hWindow)
Else
\hwindow = 0
EndIf
Break
EndIf
EndIf
Until endTime <= ElapsedMilliseconds()
EndWith
ProcedureReturn result
EndProcedure
Procedure.i Message_hWindow(*this.MessageS)
ProcedureReturn *this\hWindow
EndProcedure
Procedure.i Message_lParam(*this.MessageS)
ProcedureReturn *this\lParam
EndProcedure
Procedure.i Message_wParam(*this.MessageS)
ProcedureReturn *this\wParam
EndProcedure
Procedure Message_setCallback(*this.MessageS, hwnd.i, *callback.MessageCallback)
Protected *cb.MessageCallbackS = Message_getCallback(*this, hwnd)
If *cb
*cb\callback = *callback
Else
With *this
LockMutex(\hLockCallback)
If AddElement(\callbacks())
\callbacks()\hwnd = hwnd
\callbacks()\callback = *callback
EndIf
UnlockMutex(\hLockCallback)
EndWith
EndIf
EndProcedure
DataSection
vTable_Message:
Data.i @Message_sendMessage(), @Message_postMessage(), @Message_wait()
Data.i @Message_hWindow(), @Message_lParam(), @Message_wParam()
Data.i @Message_setCallback()
EndDataSectionCode: Alles auswählen
XIncludeFile "Message.pbi"
If Not OpenWindow(0, 0, 0, 100, 55, "Message-Test", #PB_Window_SystemMenu) : End : EndIf
StringGadget(0, 0, 0, 100, 25, "Starting...")
ButtonGadget(1, 0, 30, 100, 25, "Pause", #PB_Button_Toggle)
SetGadgetState(1, 1)
CompilerIf Defined(WM_USER, #PB_Constant) = #False
#WM_USER = $400
CompilerEndIf
#MESSAGE_USER = #WM_USER
#MESSAGE_NEW_VALUE = #WM_USER + 1
Global Msg.Message = Message_new()
Global quit = #False, pause = #False
Procedure callback(hwnd.i, msg.i, wParam.i, lParam.i)
If msg = #MESSAGE_USER
Debug "callback: Tadaa!"
ProcedureReturn 500
EndIf
EndProcedure
Procedure sendThread(*dummy)
Protected i.i
Repeat
If pause
Debug "Thread: " + Str(Msg\sendMessage(WindowID(0), #MESSAGE_USER, 0, 0))
Else
i + 1
Msg\postMessage(WindowID(0), #MESSAGE_NEW_VALUE, i, 0)
EndIf
Delay(1000)
Until quit
EndProcedure
Define hThread.i = CreateThread(@sendThread(), 0)
Msg\setCallback(WindowID(0), @callback())
Define event.i
Repeat
;Debug "mainloop"
event = Msg\wait(5000)
Select event
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
Select EventGadget()
Case 1
If GetGadgetState(1)
SetGadgetText(1, "Pause")
pause = #False
Else
SetGadgetText(1, "Start")
pause = #True
EndIf
EndSelect
Case #MESSAGE_NEW_VALUE
SetGadgetText(0, Str(Msg\wParam()))
EndSelect
ForEver
quit = #True
WaitThread(hThread)
