Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/
Da seht nirgends was von WaitWindowEvent()NicTheQuick hat geschrieben:Wichtig wäre vielleicht noch zu erwähnen, dass man dann auch nicht 'WaitWindowEvent()' nehmen sollte, sondern nur 'WindowEvent()'.
Jo. Hast recht.^^Kaeru Gaman hat geschrieben:man sollte WaitWindowEvent(TimeOut) verwenden.
bitte nicht zwei Jahre alte Krücken empfehlen.
was willst du denn stattdessen machen, deine CPU braten?NicTheQuick hat geschrieben:Find ich persönlich ziemlich blöde ein Timeout einzubauen, wenn man gleichzeitig irgend etwas in der selben Schleife ausführen will.
Code: Alles auswählen
;- Konstanten
Enumeration ; Window ID
#Window
EndEnumeration
Enumeration ; Menu ID
#Menu
EndEnumeration
Enumeration ; MenuItem ID
#Menu_Exit
#Menu_thStart
#Menu_thStop
#Menu_thContinue
#Menu_thExit
EndEnumeration
Enumeration ; Statusbar ID
#Statusbar
EndEnumeration
Enumeration ; Gadget ID
#List
EndEnumeration
; ***************************************************************************************
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
temp = FormatDate("%YYYY.%MM.%DD %HH:%II:%SS - ", Date()) + Info
AddGadgetItem(#List, -1, temp)
If CountGadgetItems(#List) > 500
RemoveGadgetItem(#List, 0)
EndIf
EndProcedure
;- Globale Variablen
Global exit = 0
;- Declare Functions
Declare thTest(*thCommand.integer)
;- 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_thStart,"Start")
MenuItem(#Menu_thStop,"Stop")
MenuItem(#Menu_thContinue,"Weiter")
MenuItem(#Menu_thExit,"Ende")
MenuBar()
MenuItem(#Menu_Exit, "Be&enden")
EndIf
; Statusbar
CreateStatusBar(#Statusbar, WindowID(#Window))
; Gadgets
If CreateGadgetList(WindowID(#Window))
ListViewGadget(#List, 0,0,0,0)
EndIf
;-- Hauptschleife
Repeat
event = WaitWindowEvent()
window = EventWindow()
menu = EventMenu()
type = EventType()
Select event
Case #PB_Event_Menu
Select menu
Case #Menu_Exit
If Not MyThread
Exit = 1
EndIf
Case #Menu_thStart
If MyThread = 0
MyThread = CreateThread(@thTest(), @Command)
Command = 1
EndIf
Case #Menu_thStop
Command = 2
Case #Menu_thContinue
Command = 3
Case #Menu_thExit
Command = 4
MyThread = 0
EndSelect
Case #PB_Event_Gadget
Case #PB_Event_CloseWindow
If Not Mythread
Exit = 1
EndIf
Case #PB_Event_Repaint
Case #PB_Event_SizeWindow
UpdateWindow()
Case #PB_Event_MoveWindow
Case #PB_Event_ActivateWindow
Case #PB_Event_SysTray
EndSelect
Until Exit
EndIf
;- Functions
Procedure thTest(*thCommand.integer)
Protected thExit = 0
Protected do
Static thRef = 0
thRef + 1
While Not thExit
Select *thCommand\i
Case 1 ; Start
If do = 0
; code befor Do
WriteLog("Start ID " + Str(thRef))
EndIf
do = 1
Case 2 ; Stop
If do = 1
; code befor Stop
WriteLog("Stop ID " + Str(thRef))
do = 2
EndIf
Case 3 ; Continue
If do = 2
; Code befor Restart
WriteLog("Continue ID " + Str(thRef))
do = 1
EndIf
Case 4 ; Exit
;If do = 2
; Code befor Exit
WriteLog("Exit ID " + Str(thRef))
do = 4
thExit = #True
;EndIf
EndSelect
; Delete Command
*thCommand\i = 0
Select do
Case 0 ; Nothing
Delay(10)
Case 1 ; Work
WriteLog("Work ID " + Str(thRef))
Delay(1000)
Case 2 ; Stop
Delay(10)
EndSelect
Wend
thRef - 1
EndProcedure
