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

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

 von Olaf Neupert

'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-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

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

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

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.

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