Statusfenster für Threads mit Abbruchfunktion

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Statusfenster für Threads mit Abbruchfunktion

Beitrag von mk-soft »

Das Fenster wird einfach im Thread erstellt und geschlossen...

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
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
ccode_new
Beiträge: 1214
Registriert: 27.11.2016 18:13
Wohnort: Erzgebirge

Re: Statusfenster für Threads mit Abbruchfunktion

Beitrag von ccode_new »

Very nice.

I like it!
Betriebssysteme: div. Windows, Linux, Unix - Systeme

no Keyboard, press any key
no mouse, you need a cat
Benutzeravatar
nicolaus
Moderator
Beiträge: 1175
Registriert: 11.09.2004 13:09
Kontaktdaten:

Re: Statusfenster für Threads mit Abbruchfunktion

Beitrag von nicolaus »

Sehr schönes Beispiel.

Ich habe es mal so abgeändert das jeder Thread und damit jedes dazugehörige Fenster automatisch ne andere Zeitdauer hat und nach dieser geschlossen wird.

Code: Alles auswählen

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, lSec
    
    lSec = Random(20000, 5000) 
    
    Debug "Start Thread " + Nummer
    text = #LF$ + "Thread Hintergrund Status" + #LF$ + "Fertig in "+Str(lSec/1000)+" 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 / (lSec/100)) % 100)
    Until TryCancelStatusWindow(*Data) Or Value >= lSec
    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

Antworten