Update v1.02
- Close Button entfernt
Code: Alles auswählen
;-TOP
;
; Comment : Thread Status Window
; Author : mk-soft
; Version : v1.02
; Create : 16.03.2018
; Update :
;
; -----------------------------------------------------------------------------
EnableExplicit
CompilerIf #PB_Compiler_Thread = 0
CompilerError "Use Compiler Option Threadsafe"
CompilerEndIf
Enumeration EventCustomValue #PB_Event_FirstCustomValue
; Nothing
EndEnumeration
Enumeration EventCustomValue
#MyEvent_ThreadStatusOpen
#MyEvent_ThreadStatusClose
#MyEvent_ThreadStatusUpdate
EndEnumeration
Structure udtThreadStatus
Signal.i
Window.i
Info.i
Progress.i
Cancel.i
x.i
y.i
dx.i
dy.i
Title.s
Text.s
Button.s
Min.i
Max.i
Value.i
EndStructure
; -----------------------------------------------------------------------------
Procedure DoOpenStatusWindow(x, y, dx, dy, Title.s, Text.s, Button.s="Cancel", Min=0, Max=100)
Protected *data.udtThreadStatus
With *data
*data = AllocateStructure(udtThreadStatus)
If *data
\x = x
\y = y
\dx = dx
\dy = dy
\Title = Title
\Text = Text
\Button = Button
\Min = Min
\Max = Max
\Signal = CreateSemaphore()
PostEvent(#MyEvent_ThreadStatusOpen, 0, 0, 0, *data)
WaitSemaphore(\Signal)
If \Window
ProcedureReturn *data
Else
FreeSemaphore(\Signal)
FreeStructure(*data)
ProcedureReturn 0 ; Error open windows
EndIf
Else
ProcedureReturn 0 ; Out of Memory
EndIf
EndWith
EndProcedure
Declare DispatchTryCancelStatusWindow()
Procedure DispatchOpenStatusWindow()
Protected *data.udtThreadStatus
With *data
*data = EventData()
If *data
\Window = OpenWindow(#PB_Any, \x, \y, \dx, \dy, \Title, #PB_Window_Tool)
If \Window
\Info = TextGadget(#PB_Any, 5, 5, \dx - 10, \dy - 65, \Text, #PB_Text_Center | #PB_Text_Border)
\Progress = ProgressBarGadget(#PB_Any, 5, \dy - 55, \dx - 10, 20, \Min, \Max)
\Cancel = ButtonGadget(#PB_Any, \dx / 2 - 60, \dy - 30, 120, 25, \Button)
SetGadgetData(\Cancel, *data)
BindGadgetEvent(\Cancel, @DispatchTryCancelStatusWindow())
EndIf
SignalSemaphore(\Signal)
EndIf
EndWith
EndProcedure
; -----------------------------------------------------------------------------
Procedure DoCloseStatusWindow(*Data.udtThreadStatus)
With *Data
If *Data
PostEvent(#MyEvent_ThreadStatusClose, 0, 0, 0, *Data)
EndIf
EndWith
EndProcedure
Procedure DispatchCloseStatusWindow()
Protected *data.udtThreadStatus
With *data
*data = EventData()
If *data
If IsWindow(\Window)
CloseWindow(\Window)
EndIf
FreeSemaphore(\Signal)
FreeStructure(*Data)
EndIf
EndWith
EndProcedure
; -----------------------------------------------------------------------------
Procedure TryCancelStatusWindow(*Data.udtThreadStatus)
If *Data
ProcedureReturn TrySemaphore(*Data\Signal)
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure DispatchTryCancelStatusWindow()
Protected *data.udtThreadStatus
With *data
*data = GetGadgetData(EventGadget())
If *data
SignalSemaphore(\Signal)
EndIf
EndWith
EndProcedure
; -----------------------------------------------------------------------------
Procedure DoUpdateStatusWindow(*Data.udtThreadStatus, Value.i)
With *Data
If *Data
\Value = Value
PostEvent(#MyEvent_ThreadStatusUpdate, 0, 0, 0, *Data)
EndIf
EndWith
EndProcedure
Procedure DispatchUpdateStatusWindow()
Protected *data.udtThreadStatus
With *data
*data = EventData()
If *data
If IsGadget(\Progress)
SetGadgetState(\Progress, \Value)
EndIf
EndIf
EndWith
EndProcedure
; -----------------------------------------------------------------------------
BindEvent(#MyEvent_ThreadStatusOpen, @DispatchOpenStatusWindow())
BindEvent(#MyEvent_ThreadStatusClose, @DispatchCloseStatusWindow())
BindEvent(#MyEvent_ThreadStatusUpdate, @DispatchUpdateStatusWindow())
; -----------------------------------------------------------------------------
; ***************************************************************************************
;-Test
CompilerIf #PB_Compiler_IsMainFile
Procedure thProgress(Nummer)
Protected *Data, Text.s, Value
Debug "Start Thread " + Nummer
text = #LF$ + "Thread Hintergrund Status" + #LF$ + "Fertig in 20 Sekunden" + #LF$ + "Zum beenden abrechen"
*Data = DoOpenStatusWindow(#PB_Ignore, #PB_Ignore, 300, 160, "Thread Nummer " + Nummer, Text); , "Abbrechen")
Repeat
Delay(500)
value + 500
DoUpdateStatusWindow(*Data, (Value / 200) % 100)
Until TryCancelStatusWindow(*Data) Or Value >= 20000
DoCloseStatusWindow(*Data)
Debug "Ende Thread " + Nummer + " Value = " + Value
EndProcedure
If OpenWindow(0, #PB_Ignore, #PB_Ignore, 200, 80, "Thread Test")
CreateThread(@thProgress(), 1)
CreateThread(@thProgress(), 2)
CreateThread(@thProgress(), 3)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
If EventWindow() = 0
Break
EndIf
EndSelect
ForEver
EndIf
CompilerEndIf