Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0576: Prozessorentlastende Sleep-Funktion

 von 

Beschreibung 

Wer in seine Programme öfters einmal Pausen einbaut, wird schnell merken, dass eine DoEvents-Schleife zwar das Programm pausiert - die Prozessorauslastung aber ansteigt! Dieser Tipp zeigt, wie es besser geht: Mit der Sleep-API!

Update von Ruru: Falls man das Programm beendet (X), so blieb der Code in der Schleife hängen und die Form entlud sich nicht.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

Sleep

Download:

Download des Beispielprojektes [2,52 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------ Anfang Projektdatei SleepLong.vbp  ------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"

Option Explicit
'Autor: O.Neupert
'E-Mail: o.neupert@paradigma-software.de

'API-Sleep deklarieren
Private Declare Sub Sleep Lib "kernel32" (ByVal lngMilliseconds As Long)

Public bUnload As Boolean

'Diese Sub lässt das Programm pausieren
'ohne die Prozessorleistung hochzujagen.
'Der Parameter "blnBeAwake" ist nur zum besseren Verständnis.
'Setzt man diesen auf False tritt nur die API-Sleep inkraft
'und der Prozessor geht hoch
Private Sub SleepLong(ByVal lngSeconds As Long, _
                    Optional ByVal blnBeAwake As Boolean = True)
   Dim t As Single, b As Boolean
   t = Timer
   Do
      Sleep 1
      
      If blnBeAwake Then
         DoEvents
      End If
      
      'Änderung am 6. April 2003:
      'in der alten Version konnte es passieren, dass die Schleife
      'um Mitternacht hinauslief und sich so in eine Endlosschleife
      'verhädderte.
      'b = Timer > t + lngSeconds
      b = Timer - t > lngSeconds
   Loop Until b
End Sub

'Hier der Aufruf mit ein paar Pausen
Private Sub Command1_Click()
    Dim i As Long
    
    'Hier zaehlen wir hoch und lassen es uns ausgeben!
    For i = i To 10 ^ 6
        
        'Update am 6. April 2003: Die Schleife wird beim
        'Beenden des Programmes nun ordnungsgemäß verlassen:
        If bUnload Then
          Unload Me
          Exit For
        End If
        
        'Ausgabe der Zahlen
        Label1.Caption = Format$(i)
        
        'Bedingung fuer die Pause(ist von Klaus geklaut ;-))
        If (i Mod 2000) = 0 And i > 0 Then
            Call SleepLong(2)
        End If
    Next i
End Sub

'Diese Methode haelt den Rechner komplett an!!
'Also Achtung nicht verwenden, dient nur zur DEMO!!
Private Sub Command2_Click()
    Dim i As Long
    
    For i = i To 10 ^ 6
        Label1.Caption = Format$(i)
        If (i Mod 2000) = 0 And i > 0 Then
            Call SleepLong(2, False)
        End If
    Next i
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  bUnload = True
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'------------- Ende Projektdatei SleepLong.vbp  -------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 5 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von Sven Fichtner am 04.05.2007 um 13:45

Statt die Deklaration als long zusetzen sollte man sie lieber Integer setzen.

Da bei mir das mit dem long nicht hinhaut.

MFG

Sven

Kommentar von Thomas Ehrlich am 15.12.2004 um 21:24

Hallo,

soetwas habe ich lange gesucht.

Leider fällt die Funktion über den Tageswechsel in eine Endlosschleife.
Da nur die Zeit geprüft wird, schlägt der Wert nach Mitternacht um.

Ich habe eine zusätzliche Prüfung eingebaut.
Mit p wird die Pausenzeit runtergezählt und angezeigt.
Wenn der Wert p > als die übergebene Pausenzeit ist, wird die Schleife verlassen.

Bin mit dem Tipp super zufrieden und die CPU freut sich :-)

Gruß Thomas

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal lngMilliseconds As Long)
Dim p As Long
Sub SleepLong(ByVal lngSeconds As Long, _
Optional ByVal blnBeAwake As Boolean = True)
Dim t As Single, b As Boolean
t = Timer
p = 0
Do
Sleep 1

If S_BIT = True Or p > lngSeconds Then
Exit Do
End If
p = lngSeconds - (Timer - t)
FPSW_ZFIS.STATUS_ANZ.Text = "Anwendung Pause " & p & " Sekunden!"
DoEvents

b = Timer - t > lngSeconds
Loop Until b
End Sub

Kommentar von P. Kapfer am 12.11.2004 um 16:34

Übrigens kann man die Funktion "SleepLong" auch weglassen, sofern die Anwendung nur wenige (Milli-)Sekunden schlafen gelegt werden soll. Die Übergabe der Millisekunden an die API-Funktion Sleep genügt.

Kommentar von am 13.04.2004 um 22:01

Die Funktion hängt sich nach 0 Uhr in einer Endlosschleife verfing,wenn der Aufruf vor 0 Uhr und der gewünschte Endzeitpunkt nach 0Uhr liegt .
Ganz einfach aus dem folgendem Grund:
Sagen wir mal wir rufen die Funktion 1 Minuten vor 0 Uhr auf und die Schleife soll das Programm 3 Minuten anhalten, so ist t=86340. Beginnt jedoch der neue Tag, so springt Der Timer von 86340 auf 0 um.

Um 0 Uhr -> Timer-t = -86340
Um 0:01 Uhr -> Timer-t = -86280

Da dies nie größer als 180 wird haben wir eine Endlosschleife

Lösung:

Private Sub SleepLong(ByVal lngSeconds As Long)
Dim t As Single, b As Boolean, diff As Single
t = Timer
Do
Sleep 1

DoEvents

If Timer - t < -0.1 Then
diff = 86400 + (Timer - t)
Else
diff = Timer - t
End If

b = diff > lngSeconds
Loop Until b
End Sub

Kommentar von F. Hoffmann am 10.04.2003 um 12:33

siehe auch http://www.aboutvb.de/kom/artikel/komsleeper.htm
--> Verwendung o.a. Funktion als Active-X.dll eingebunden verhindert durch Thread-Nutzung Komplettstillstand der Anwendung.