StatusWindow for Threads with Cancel function

Share your advanced PureBasic knowledge/code with the community.
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

StatusWindow for Threads with Cancel function

Post by mk-soft »

Open and close status windows inside a thread...

Update v1.02
- Remove Close Button

Code: Select all

;-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
Works with all OS :wink:
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive