PureBoard

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()
EndDataSection

Code: 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)

Code: Alles auswählen

      SetWindowCallback(*callback)