PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Progressbar mit Start Pause und Exit

https://www.purebasic.fr/german/viewtopic.php?t=28526

Seite 1 von 1

Progressbar mit Start Pause und Exit

Verfasst: 16.11.2014 23:31
von frankmannb
Hallo,

ich würde gerne eine Programm realisieren, dass ein Verzeichnis (P_RekursiveDateisuche(ImportPfad.s) permanent auf deren Inhalt überwacht. Die darin gefundenen Dateien sollen im späteren Verlauf eingelesen und entsprechend dem Inhalt weiterverarbeitet werden. Um zu sehen, dass das Programm läuft möchte ich gerne eine Progressbar einsetzen, die immer vor der Suche im Verzeichnis auf 0 gesetzt wird und sobald das Verzeichnis durchsucht wurde auf 100 & springt. Das ganze soll dann wiederholt werden, es sei denn jemand drückt die Pause oder Exit-Taste. Hatte an eine Repeat:Until- Schleife gedacht, aber dann friert mir immer das Fenster ein.

Hier mein bisheriger Code. Wahrscheinlich eine relativ einfache Sache, aber ich komme momentan einfach nicht drauf. Villeicht ist jemand von euch so nett, mir zu helfen.
Ich danke in jedem Fall im Vorraus.

Code: Alles auswählen

Enumeration 
  #BT_Exit
  #BT_StartPause
  #PRB_Dateidurchlauf
  #TG_Dateidurchlauf
  #Timer
EndEnumeration

Global quit

; Rekursive Dateisuche
Procedure P_RekursiveDateisuche(inputpath.s)
  
  dir = ExamineDirectory(#PB_Any, inputpath, "*.*")
  
  While NextDirectoryEntry(dir)
    
    dir_type.l        = DirectoryEntryType(dir)
    dir_name.s        = DirectoryEntryName(dir)
    dir_path.s        = inputpath + dir_name
    
    If dir_name = "." Or dir_name = ".." 
      Continue
    EndIf
    
    If dir_type = #PB_DirectoryEntry_File
      If ReadFile(0, dir_path)   ; wenn die Datei geöffnet werden konnte, setzen wir fort...
        While Eof(0) = 0         ; sich wiederholende Schleife bis das Ende der Datei ("end of file") erreicht ist
          line.s   = ReadString(0)
          
        Wend
        CloseFile(0)               ; schließen der zuvor geöffneten Datei
      Else
        MessageRequester("Information","Konnte Datei nicht öffnen!")
      EndIf
    EndIf
  Wend
  SetGadgetState(#PRB_Dateidurchlauf,100)
  FinishDirectory(dir)
EndProcedure



ImportPfad.s = "c:\temp\daten\"
ArchivPfad.s = "c:\temp\daten2\"

If OpenWindow(0, 0, 0, 600, 200 , "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget)
  
  ProgressBarGadget(#PRB_Dateidurchlauf,  10, 10, 580,  30, 0, 100,#PB_ProgressBar_Smooth)
  ButtonGadget(#BT_StartPause,150,100,150,50,"START")
  ButtonGadget(#BT_Exit,300,100,150,50,"EXIT")
  TextGadget(#TG_Dateidurchlauf,240,70,150,50,"Suche WMS-Telegramme")
  AddWindowTimer(0, #Timer, 20)
  
  Value = 0
  
  Repeat
    
    Event = WaitWindowEvent()
    
    Select event
        

              
      Case #PB_Event_Gadget
        

        Select EventGadget()
            
          Case #BT_StartPause
            
            If GetGadgetText(#BT_StartPause) = "START"
              SetGadgetText(#BT_StartPause,"PAUSE")
              SetGadgetState(#PRB_Dateidurchlauf,0)
              Repeat
                P_RekursiveDateisuche(ImportPfad.s)               
              Until quit = 1
            Else
              SetGadgetText(#BT_StartPause,"START")
            EndIf
            
            
            
          Case #BT_Exit
            quit = 1
            
        EndSelect ; Select EventGadget()
        
      Case #PB_Event_Menu
        
        
    EndSelect
    
    
  Until Event = #PB_Event_CloseWindow Or Quit = 1
EndIf
Besten Dank und Grüße
frankmannb

Re: Progressbar mit Start Pause und Exit

Verfasst: 17.11.2014 12:56
von matbal
An der Repeat/Until-Schleife im Eventloop hältst du den Eventloop an, da jetzt nur noch diese Repeat/Until-Schleife durchläuft.
Die Stelle im Eventloop, wo du quit = 1 setzen willst, erreichst du nie.

Verschiedele Lösungsansätze:
1. Hier wäre ein Thread für die Suche am besten geeignet. Dann läuft der Eventloop und die Suche parallel ab.

2. BindGadgetEvent() für die Buttons verwenden und ein zusätzliches WindowEvent() in der Suchschleife einbauen, würde auch gehen. (Die EventProceduren werden nur aufgerufen, wenn der Eventloop läuft, das heißt WindowEvent() abgerufen wird)

Beispiel:

Code: Alles auswählen

EnableExplicit

Enumeration 
   #BT_Exit
   #BT_StartPause
   #PRB_Dateidurchlauf
   #TG_Dateidurchlauf
   #Timer
EndEnumeration

Global quit, pause
Global ImportPfad.s = "c:\temp\daten\"
Global ArchivPfad.s = "c:\temp\daten2\"

Macro DoEvents()
   While WindowEvent() : Wend
EndMacro

; Rekursive Dateisuche
Procedure P_RekursiveDateisuche(inputpath.s)
   
   Protected dir = ExamineDirectory(#PB_Any, inputpath, "*.*")
   
   DoEvents()
   
   If dir = 0
      Debug "Verzeichnis Existiert nicht"
      ProcedureReturn 
   EndIf
   
   While NextDirectoryEntry(dir)
      
      Protected dir_type.l        = DirectoryEntryType(dir)
      Protected dir_name.s        = DirectoryEntryName(dir)
      Protected dir_path.s        = inputpath + dir_name
      Protected line.s
      
      If dir_name = "." Or dir_name = ".." 
         Continue
      EndIf
      
      Debug dir_name
      
      If dir_type = #PB_DirectoryEntry_File
         If ReadFile(0, dir_path)   ; wenn die Datei geöffnet werden konnte, setzen wir fort...
            While Eof(0) = 0        ; sich wiederholende Schleife bis das Ende der Datei ("end of file") erreicht ist
               line.s   = ReadString(0)
               DoEvents()
            Wend
            CloseFile(0)               ; schließen der zuvor geöffneten Datei
         Else
            MessageRequester("Information","Konnte Datei nicht öffnen!")
         EndIf
      EndIf
   Wend
   SetGadgetState(#PRB_Dateidurchlauf,100)
   FinishDirectory(dir)
EndProcedure

Procedure Button_StartPause()
   If GetGadgetText(#BT_StartPause) = "START"
      SetGadgetText(#BT_StartPause,"PAUSE")
      SetGadgetState(#PRB_Dateidurchlauf,0)
      
      pause = 0
      Repeat
         SetGadgetState(#PRB_Dateidurchlauf, 0)
         P_RekursiveDateisuche(ImportPfad.s) 
         Delay(100)                    ; ohne Delay sieht man die 100% nicht
      Until quit = 1 Or pause = 1
      
   Else
      SetGadgetText(#BT_StartPause,"START")
      pause = 1
   EndIf
EndProcedure

Procedure Button_Exit()
   quit = 1
EndProcedure





If OpenWindow(0, 0, 0, 600, 200 , "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget)
   
   ProgressBarGadget(#PRB_Dateidurchlauf,  10, 10, 580,  30, 0, 100,#PB_ProgressBar_Smooth)
   ButtonGadget(#BT_StartPause,150,100,150,50,"START")
   ButtonGadget(#BT_Exit,300,100,150,50,"EXIT")
   TextGadget(#TG_Dateidurchlauf,240,70,150,50,"Suche WMS-Telegramme")
   AddWindowTimer(0, #Timer, 20)
   
   BindGadgetEvent(#BT_StartPause, @Button_StartPause())
   BindGadgetEvent(#BT_Exit, @Button_Exit())
   
   Define Value = 0
   Define Event
   
   Repeat
      Event = WaitWindowEvent()      
   Until Event = #PB_Event_CloseWindow Or Quit = 1
EndIf
3. Den Eventloop in eine Prozedur packen, so daß du ihn von beliebiger Stelle aufrufen kannst. Da du während deiner Suche auch wissen willst, ob EXIT gedrückt wurde, müßtest du dort auch immer deine Eventloop-Prozedur aufrufen.

Beispiel:

Code: Alles auswählen

EnableExplicit

Enumeration 
   #BT_Exit
   #BT_StartPause
   #PRB_Dateidurchlauf
   #TG_Dateidurchlauf
   #Timer
EndEnumeration

Global quit, pause
Global ImportPfad.s = "c:\temp\daten\"
Global ArchivPfad.s = "c:\temp\daten2\"

Declare DoEvents(TimeOut = #PB_Default)

; Rekursive Dateisuche
Procedure P_RekursiveDateisuche(inputpath.s)
   
   Protected dir = ExamineDirectory(#PB_Any, inputpath, "*.*")
   
   DoEvents(0)
   
   If dir = 0
      Debug "Verzeichnis Existiert nicht"
      ProcedureReturn 
   EndIf
   
   While NextDirectoryEntry(dir)
      
      Protected dir_type.l        = DirectoryEntryType(dir)
      Protected dir_name.s        = DirectoryEntryName(dir)
      Protected dir_path.s        = inputpath + dir_name
      Protected line.s
      
      If dir_name = "." Or dir_name = ".." 
         Continue
      EndIf
      
      Debug dir_name
      
      If dir_type = #PB_DirectoryEntry_File
         If ReadFile(0, dir_path)   ; wenn die Datei geöffnet werden konnte, setzen wir fort...
            While Eof(0) = 0        ; sich wiederholende Schleife bis das Ende der Datei ("end of file") erreicht ist
               line.s   = ReadString(0)
               DoEvents(0)
            Wend
            CloseFile(0)               ; schließen der zuvor geöffneten Datei
         Else
            MessageRequester("Information","Konnte Datei nicht öffnen!")
         EndIf
      EndIf
   Wend
   SetGadgetState(#PRB_Dateidurchlauf,100)
   FinishDirectory(dir)
EndProcedure

Procedure DoEvents(timeOut = #PB_Default)
   Protected Event
   Event = WaitWindowEvent(timeOut)
   
   Select Event
      Case #PB_Event_CloseWindow
         quit = 1
         
      Case #PB_Event_Gadget
         
         
         Select EventGadget()
               
            Case #BT_StartPause
               
               If GetGadgetText(#BT_StartPause) = "START"
                  SetGadgetText(#BT_StartPause,"PAUSE")
                  
                  pause = 0
                  Repeat
                     SetGadgetState(#PRB_Dateidurchlauf,0)   
                     P_RekursiveDateisuche(ImportPfad.s)  
                     Delay(100)
                  Until quit = 1 Or pause = 1
               Else
                  SetGadgetText(#BT_StartPause,"START")
                  pause = 1
               EndIf
               
               
               
            Case #BT_Exit
               quit = 1
               
         EndSelect ; Select EventGadget()
         
      Case #PB_Event_Menu
         
         
   EndSelect
   
   
   
EndProcedure



If OpenWindow(0, 0, 0, 600, 200 , "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget)
   
   ProgressBarGadget(#PRB_Dateidurchlauf,  10, 10, 580,  30, 0, 100,#PB_ProgressBar_Smooth)
   ButtonGadget(#BT_StartPause,150,100,150,50,"START")
   ButtonGadget(#BT_Exit,300,100,150,50,"EXIT")
   TextGadget(#TG_Dateidurchlauf,240,70,150,50,"Suche WMS-Telegramme")
   AddWindowTimer(0, #Timer, 20)
   
   Define Value = 0
   Define Event
   
   Repeat
      
      DoEvents()
      
   Until Quit = 1
EndIf
4. Immer am Ende des Eventloop die Suche (ohne Repeat/Until) aufrufen, und den WaitWindowEvent mit TimeOut versehen. Hier wird der Eventloop aber stark gebremst, wenn die Suche lange dauert.

Re: Progressbar mit Start Pause und Exit

Verfasst: 17.11.2014 21:40
von frankmannb
Super, danke Dir. Ich werde mal schauen, ob ich mit deinem zweitem Beispiel mein Projekt verwirklichen kann, auch wenn ich noch nicht alles vestehe, wie z.B. diese Declaration.

Code: Alles auswählen

Declare DoEvents(TimeOut = #PB_Default)
oder dieser Code

Code: Alles auswählen

DoEvents(0)
. Wird DoEvents(0) immer aufgerufen damit zwischenzeitlich geprüft wird, ob ein Event vorhanden ist?

Re: Progressbar mit Start Pause und Exit

Verfasst: 17.11.2014 23:04
von matbal
Declare benötigt der Compiler, wenn eine Prozedur verwendet wird, bevor sie definiert wurde.

TimeOut in DoEvents ist ein optionaler Parameter. Gibst du keine Zeit an, wird #PB_Default genommen. WaitWindowEvent() wartet dann, wenn keine Events anliegen.

Übergibst du 0 als Parameter, fällt die Wartezeit weg. Wie du schon richtig festgestellt hast, mit DoEvents(0) wird kurz geprüft, ob ein Event vorhanden ist.

p.s. hier noch eine Variante mit Thread. Im Prinzip arbeitet sie genauso wie die anderen beiden Codes.

Code: Alles auswählen

EnableExplicit

Enumeration 
   #BT_Exit
   #BT_StartPause
   #PRB_Dateidurchlauf
   #TG_Dateidurchlauf
   #Timer
EndEnumeration

Global quit, pause
Global ImportPfad.s = "c:\temp\daten\"
Global ArchivPfad.s = "c:\temp\daten2\"
Define th

; Rekursive Dateisuche
Procedure P_RekursiveDateisuche(inputpath.s)
   
   Protected dir = ExamineDirectory(#PB_Any, inputpath, "*.*")
   
   If dir = 0
      Debug "Verzeichnis existiert nicht"
      ProcedureReturn 
   EndIf
   
   While NextDirectoryEntry(dir)
      
      Protected dir_type.l        = DirectoryEntryType(dir)
      Protected dir_name.s        = DirectoryEntryName(dir)
      Protected dir_path.s        = inputpath + dir_name
      Protected line.s
      
      If dir_name = "." Or dir_name = ".." 
         Continue
      EndIf
      
      Debug dir_name
      
      If dir_type = #PB_DirectoryEntry_File
         If ReadFile(0, dir_path)   ; wenn die Datei geöffnet werden konnte, setzen wir fort...
            While Eof(0) = 0        ; sich wiederholende Schleife bis das Ende der Datei ("end of file") erreicht ist
               line.s   = ReadString(0)
;                If quit Or pause 
;                   Break
;                EndIf
               
            Wend
            CloseFile(0)               ; schließen der zuvor geöffneten Datei
         Else
            MessageRequester("Information","Konnte Datei nicht öffnen!")
         EndIf
         
      EndIf
;       If quit Or pause
;          Break
;       EndIf
      
   Wend
   SetGadgetState(#PRB_Dateidurchlauf,100)
   FinishDirectory(dir)

EndProcedure

Procedure Thread_Suche(*x)
   
   Repeat
      SetGadgetState(#PRB_Dateidurchlauf, 0)
      P_RekursiveDateisuche(ImportPfad.s)     
      Delay(100)
   Until quit = 1 Or pause = 1
   
EndProcedure




If OpenWindow(0, 0, 0, 600, 200 , "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget)
   
   ProgressBarGadget(#PRB_Dateidurchlauf,  10, 10, 580,  30, 0, 100,#PB_ProgressBar_Smooth)
   ButtonGadget(#BT_StartPause,150,100,150,50,"START")
   ButtonGadget(#BT_Exit,300,100,150,50,"EXIT")
   TextGadget(#TG_Dateidurchlauf,240,70,150,50,"Suche WMS-Telegramme")
   AddWindowTimer(0, #Timer, 20)
   
   Define Value = 0
   Define Event
   
   Repeat
      
      Event = WaitWindowEvent()
      
      Select event
            
         Case #PB_Event_CloseWindow
            quit = 1
            
         Case #PB_Event_Gadget
            
            
            Select EventGadget()
                  
               Case #BT_StartPause
                  
                  If GetGadgetText(#BT_StartPause) = "START"
                     pause = 0
                     SetGadgetText(#BT_StartPause,"PAUSE")
                     
                     If Not IsThread(th)
                        th = CreateThread(@Thread_Suche(), 0)
                     EndIf
                  Else
                     
                     SetGadgetText(#BT_StartPause,"START")
                     pause = 1
                  EndIf
                  
                  
                  
               Case #BT_Exit
                  quit = 1
                  
            EndSelect ; Select EventGadget()
            
         Case #PB_Event_Menu
            
            
      EndSelect
      
      
   Until (Quit = 1  And Not IsThread(th))
EndIf

Re: Progressbar mit Start Pause und Exit

Verfasst: 18.11.2014 20:24
von frankmannb
Hi matbal,

leider funktioniert die letzte Version mit Thread nicht, ich erhalte immer die Fehlermeldung "konnte die Datei nicht öffnen" :cry: . Ferner wäre für mich jetzt gut zu wissen, welche Variante jetzt eigentlich die am besten zu verwendende ist?

Besten dank und Grüße
frankmannb

Re: Progressbar mit Start Pause und Exit

Verfasst: 18.11.2014 20:57
von matbal
Zum Testen hatte ich bei mir andere Pfade eingestellt. Als ich die Pfade vorm Posten wieder zurück auf deine Werte gestellt habe, habe ich bei "c:\temp\daten\" den letzten Backslash vergessen.
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de