nach dem ich mal wieder mit Linux gearbeitet habe und mal wieder feststelle das die GUI unter Linux überhaupt gar nicht Threadsafe ist, habe ich mir ein kleine Messagesystem gebastelt.
Es gibt zwar schon einige gute Beispiele die mir allerdings zu aufwendig in der Anwendung sind.
Kurze Anleitung:
- Die Callback Procedure muss folgenden Aufbau haben: MsgCB(msg, *pData, text)
- SetMsgCallback(@MsgCB()): Setzen der Callback Procedure
- SendMsg(msg [,*pdata [,text]]): Message senden und warten auf Verarbeitung
- PostMsg(msg [,*pdata [,text]]): Message senden ohne zu warten
- DispatchMsg(): Verarbeitet die Messages. Aufruf direkt nach WaitWindowEvent(...).
Den Parameter Text habe ich mir noch dazu gebastelt um nicht selber bei einer PostMsg den Text sichern zu müssen.
Messages.pb
Code: Alles auswählen
;-TOP
; Kommentar : Thread-Message-System
; Author : mk-soft
; Second Author :
; Datei : messages.pb
; Version : 1.01
; Erstellt : 13.06.2010
; Geändert :
;
; Compilermode :
;
; ***************************************************************************************
Prototype ProtoMsgCallback(msg, *pdata, text.s)
Global __MsgMutex__
Global __MsgCallback__.ProtoMsgCallback = 0
__MsgMutex__ = CreateMutex()
Structure __udtMessages__
msg.i
*pdata
text.s
post.i
ready.i
result.i
EndStructure
Global NewList __Messages__.__udtMessages__()
; ***************************************************************************************
Procedure SendMsg(msg, *pdata = 0, text.s = "")
Protected *message.__udtMessages__, result
LockMutex(__MsgMutex__)
AddElement(__Messages__())
*message = __Messages__()
With *message
\msg = msg
\pdata = *pdata
\text = text
\ready = #False
EndWith
UnlockMutex(__MsgMutex__)
While *message\ready = #False
Delay(10)
Wend
LockMutex(__MsgMutex__)
result = *message\result
ChangeCurrentElement(__Messages__(), *message)
DeleteElement(__Messages__())
UnlockMutex(__MsgMutex__)
ProcedureReturn result
EndProcedure
; ***************************************************************************************
Procedure PostMsg(msg, *pdata = 0, text.s = "")
Protected *message.__udtMessages__
LockMutex(__MsgMutex__)
AddElement(__Messages__())
*message = __Messages__()
With *message
\msg = msg
\pdata = *pdata
\text = text
\post = #True
\ready = #False
EndWith
UnlockMutex(__MsgMutex__)
EndProcedure
; ***************************************************************************************
Procedure SetMsgCallback(*MsgCallback)
Protected *old
*old = __MsgCallback__
__MsgCallback__ = *MsgCallback
ProcedureReturn *old
EndProcedure
; ***************************************************************************************
Procedure DispatchMsg()
LockMutex(__MsgMutex__)
ForEach __Messages__()
With __Messages__()
If \ready = #False
If __MsgCallback__
\result = __MsgCallback__(\msg, \pdata, \text)
Else
\result = 0
EndIf
\ready = #True
If \post
DeleteElement(__Messages__())
EndIf
EndIf
EndWith
Next
UnlockMutex(__MsgMutex__)
EndProcedure
Code: Alles auswählen
IncludeFile "Messages.pb"
;- Messages
Enumeration
#Info
EndEnumeration
;- Konstanten
Enumeration ; Window ID
#Window
EndEnumeration
Enumeration ; Menu ID
#Menu
EndEnumeration
Enumeration ; MenuItem ID
#Menu_Exit
EndEnumeration
Enumeration ; Statusbar ID
#Statusbar
EndEnumeration
Enumeration ; Gadget ID
#List
EndEnumeration
; ***************************************************************************************
; Es müssen immer alle Variablen declariert werden
EnableExplicit
; ***************************************************************************************
Procedure UpdateWindow()
Protected x,y,dx,dy
Protected mn,st,tb
x = 0
y = 0
mn = MenuHeight()
st = StatusBarHeight(#StatusBar)
;tb = ToolBarHeight(#ToolBar)
dx = WindowWidth(#Window)
dy = WindowHeight(#Window) - mn - st - tb
ResizeGadget(#List, x, y, dx, dy)
EndProcedure
Procedure WriteLog(Info.s)
Protected temp.s, count
temp = FormatDate("%YYYY.%MM.%DD %HH:%II:%SS - ", Date()) + Info
AddGadgetItem(#List, -1, temp)
count = CountGadgetItems(#List)
If count > 500
RemoveGadgetItem(#List, 0)
count - 1
EndIf
count - 1
SetGadgetState(#List, count)
EndProcedure
;- Globale Variablen
Global exit = 0
; Message Callback
Procedure MsgCB(msg, *pData, text.s)
Protected result
Select msg
Case #Info : result = WriteLog(text)
Default
result = 0
EndSelect
ProcedureReturn result
EndProcedure
; Kleiner Testthread
Procedure MyThread(id)
Protected i
While Not exit
For i = 1 To 10
PostMsg(#Info, 0, "Post Message " + Str(i))
Next
SendMsg(#Info, 0, "Send Message")
Delay(1000)
Wend
EndProcedure
; Main in eine Procedure gekapselt
Procedure Main()
Protected style, event, window, menu, gadget, type
;- Fenster
style = #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget
If OpenWindow(#Window, #PB_Ignore, #PB_Ignore, 400, 300, "Fenster", style)
; Menu
If CreateMenu(#Menu, WindowID(#Window))
MenuTitle("&Datei")
MenuItem(#Menu_Exit, "Be&enden")
EndIf
; Statusbar
CreateStatusBar(#Statusbar, WindowID(#Window))
; Gadgets
ListViewGadget(#List, 0,0,0,0)
; Set MsgCallback
SetMsgCallback(@MsgCB())
; Init
;WriteLog("Programm gestartet")
; Postmessage senden -> Wartet nicht auf Verarbeitung
PostMsg(#Info, 0, "Programm gestartet")
; Thread starten
Global hThread = CreateThread(@MyThread(), 0)
;-- Hauptschleife
Repeat
event = WaitWindowEvent(10)
; Messages verarbeiten
DispatchMsg()
Select event
Case #PB_Event_Menu ; ein Menü wurde ausgewählt
menu = EventMenu()
Select menu
Case #Menu_Exit
Exit = 1
EndSelect
Case #PB_Event_Gadget ; ein Gadget wurde gedrückt
gadget = EventGadget()
type = EventType()
Case #PB_Event_CloseWindow ; das Schließgadget vom Fenster wurde gedrückt
window = EventWindow()
If window = #Window
Exit = 1
EndIf
Case #PB_Event_Repaint ; der Fensterinhalt wurde zerstört und muss neu gezeichnet werden (nützlich für 2D Grafik-Operationen)
Case #PB_Event_SizeWindow ; das Fenster wurde in der Größe verändert
window = EventWindow()
If window = #Window
UpdateWindow()
EndIf
Case #PB_Event_MoveWindow ; das Fenster wurde verschoben
Case #PB_Event_ActivateWindow ; das Fenster wurde aktiviert (hat den Fokus erhalten)
Case #PB_Event_SysTray ; das SysTray wurde aktiviert
EndSelect
Until Exit
EndIf
EndProcedure : Main()
