Da für bitten sich am bessen Threads an die gesteuert werden müssen.
Es gibt einige Methoden Threads zu steuerung (Mutex, Semaphore, etc)
Die einfachste Methode ist aber über globale Variablen.
Wo bei aber da rauf geachtet werden muss wann die globale Variable geschieben und gelesen werden darf.
Diese erreicht man durch ein einfaches Handshake der Command-Variable.
Habe mal ein Beispiel geschieben welches man als Basis nehmen kann...
Code: Alles auswählen
;-TOP
;
; Thread example by mk-soft
;
; Compileroption Threadsafe
;
EnableExplicit
; *************************************************************************************************
Global exit
Global mutexLog
#WinMain = 0
#WinStatusbar = 0
#WinMenu = 0
Enumeration ; MenuItems
#WinMenu_StartThread
#WinMenu_Cmd1
#WinMenu_Cmd2
#WinMenu_Cancel
#WinMenu_ExitThread
#WinMenu_Exit
EndEnumeration
Enumeration ; Gadgets
#WinMain_Listbox
EndEnumeration
#WinMainStyle = #PB_Window_SystemMenu | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget
#WinVersion = "v1.0"
#WinTitle = "Testprogram (" + #WinVersion + ")"
; *************************************************************************************************
Procedure UpdateWindow(Window = 0, Gadget = 0, Menubar = #PB_Ignore, Statusbar = #PB_Ignore, Toolbar = #PB_Ignore)
Protected x,y,dx,dy
x = 0
y = 0
If Toolbar <> #PB_Ignore
y + ToolBarHeight(Toolbar)
EndIf
dx = WindowWidth(Window)
dy = WindowHeight(Window)
dy - y
If MenuBar <> #PB_Ignore
dy - MenuHeight()
EndIf
If Statusbar <> #PB_Ignore
dy - StatusBarHeight(Statusbar)
EndIf
ResizeGadget(Gadget, x, y, dx, dy)
EndProcedure
; *************************************************************************************************
Procedure FcWriteLog(Text.s, Gadget = 0)
Protected temp.s, count
temp = FormatDate("%yyyy-%mm-%dd %hh:%ii:%ss -> ", Date())
temp + Text
AddGadgetItem(Gadget, -1, temp)
count = CountGadgetItems(Gadget)
If count > 1000
RemoveGadgetItem(Gadget, 0)
count - 1
EndIf
count - 1
SendMessage_(GadgetID(Gadget), #LB_SETTOPINDEX, count, 0)
EndProcedure
mutexLog = CreateMutex()
Macro WriteLog(Text, Gadget = 0)
LockMutex(mutexLog) : FcWriteLog(Text, Gadget) : UnlockMutex(mutexLog)
EndMacro
; *************************************************************************************************
Structure udtData
*hThread
cmd.i
param1.i
param2.i
errorcode.i
EndStructure
Enumeration ; Command
#cmd_state_no_running
#cmd_state_startup
#cmd_state_shutdown
#cmd_state_ready
#cmd_cancel
#cmd_exit
#cmd_begin
#cmd_1
#cmd_2
#cmd_end
EndEnumeration
Global MyData.udtData
Procedure thWork(*thData.udtData)
Protected count, infotext.s
With *thData
WriteLog("Startup Thread...")
\cmd = #cmd_state_startup
Delay(1000)
WriteLog("Started Thread")
\cmd = #cmd_state_ready
Repeat
Select \cmd
Case #cmd_1
For count = \param1 To \param2
If \cmd = #cmd_cancel
WriteLog("Abruch...")
Break
EndIf
infotext = "Command " + Str(\cmd) + ": Count = " + Str(count)
WriteLog(infotext)
Delay(200)
Next
\cmd = #cmd_state_ready
Case #cmd_2
For count = \param1 To \param2
If \cmd = #cmd_cancel
WriteLog("Abruch...")
Break
EndIf
infotext = "Command " + Str(\cmd) + ": Count = " + Str(count)
WriteLog(infotext)
Delay(500)
Next
\cmd = #cmd_state_ready
Case #cmd_exit
Break
Default
Delay(10)
EndSelect
ForEver
\cmd = #cmd_state_shutdown
WriteLog("Shutdown Thread...")
Delay(1000)
WriteLog("Stopped Thread.")
\cmd = #cmd_state_no_running
EndWith
EndProcedure
; *************************************************************************************************
Procedure Main()
Protected event
If OpenWindow(#WinMain, #PB_Any, #PB_Any, 800, 600, #WinTitle, #WinMainStyle)
If CreateMenu(#WinMenu, WindowID(#WinMain))
MenuTitle("&Datei")
MenuItem(#WinMenu_StartThread, "&Start")
MenuItem(#WinMenu_Cmd1,"Kommando &1")
MenuItem(#WinMenu_Cmd2,"Kommando &2")
MenuItem(#WinMenu_Cancel,"Kommando Ab&brechen")
MenuItem(#WinMenu_ExitThread, "Sto&p")
MenuBar()
MenuItem(#WinMenu_Exit, "Be&enden")
EndIf
If CreateStatusBar(#WinStatusbar, WindowID(#WinMain))
AddStatusBarField(#PB_Ignore)
EndIf
ListViewGadget(#WinMain_Listbox, 0,0,0,0)
Else
End
EndIf
WriteLog("Program startet...")
Repeat
; Main loop
event = WaitWindowEvent()
Select event
Case #PB_Event_Menu
Select EventMenu()
Case #WinMenu_StartThread
If MyData\cmd = #cmd_state_no_running
MyData\hThread = CreateThread(@thWork(), MyData)
Else
WriteLog("Thread allway running...")
EndIf
Case #WinMenu_Cmd1
If MyData\cmd = #cmd_state_ready
MyData\param1 = 1
MyData\param2 = 50
MyData\cmd = #cmd_1
Else
If myData\cmd = #cmd_state_no_running
WriteLog("Thread is not running")
Else
WriteLog("Thread is work")
EndIf
EndIf
Case #WinMenu_Cmd2
If MyData\cmd = #cmd_state_ready
MyData\param1 = 51
MyData\param2 = 100
MyData\cmd = #cmd_2
Else
If myData\cmd = #cmd_state_no_running
WriteLog("Thread is not running")
Else
WriteLog("Thread is work")
EndIf
EndIf
Case #WinMenu_Cancel
If MyData\cmd > #cmd_begin And MyData\cmd < #cmd_end
MyData\cmd = #cmd_cancel
EndIf
Case #WinMenu_ExitThread
If MyData\cmd = #cmd_state_ready
MyData\cmd = #cmd_exit
Else
If MyData\cmd = #cmd_state_no_running
WriteLog("Thread is not running")
Else
WriteLog("Thread is work")
EndIf
EndIf
Case #WinMenu_Exit
If MyData\cmd = #cmd_state_no_running
exit = #True
Else
WriteLog("Thread is running... Stop Thread first.")
EndIf
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
EndSelect
Case #PB_Event_SizeWindow
UpdateWindow(#WinMain, #WinMain_Listbox, #WinMenu, #WinStatusbar)
Case #PB_Event_CloseWindow
If MyData\cmd = #cmd_state_no_running
exit = #True
Else
WriteLog("Thread is running... Stop Thread first.")
EndIf
EndSelect
Until Exit
EndProcedure : Main() : End
; *************************************************************************************************
P.S. Kleine Erweiterung mit Kommando abbrechen
