Tipp 0507 SetWaitableTimer, die bessere Sleep-Alternative
Autor/Einsender:
Datum:
  Detlev Schubert
09.08.2006
Entwicklungsumgebung:   VB 6
Die API-Funktion Sleep kennt fast jeder VB-Programmierer, da es die einfachste Möglichkeit ist, den Programmablauf für einen bestimmten Zeitraum anzuhalten. Jedoch wird durch den Aufruf dieser Funktion jeder weitere Programmablauf (auch weitere Threads wie z.B. Timer) gestoppt. Dies führt zum "Einfrieren" aller Fenster und zum absoluten Stillstand der aktuellen Anwendung.
Um dies zu umgehen, hält das Windows-Api mit der Funktion SetWaitableTimer eine weitaus bessere Alternative parat, nach deren Aufruf nur der aktuelle Thread angehalten wird und sowohl die Standard Fensterereignisse als auch alle weiteren Ereignisse (z.B. Timer oder wie im Beispiel eine ProgressBar) weiterhin verfügbar sind und abgearbeitet werden.
Dies eignet sich nicht nur zum Einsatz bei einer Thread-Programmierung sondern auch z.B. für Fenster mit Fortschrittsanzeigen.
Code im Codebereich des Moduls
 
'Der Tipp wurde auf Basis des MS-Knowledge-Artikels
'How To Use SetWaitableTimer With Visual Basic
'http://support.microsoft.com/kb/231298/en-us
'erstellt, in dem jedoch eine Reihe von Konstanten und
'API-Funktionen angegeben sind, die für die Realisierung
'des Tipps nicht verwendet werden.

Option Explicit

Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Private Const WAIT_OBJECT_0& = 0

Private Const INFINITE = &HFFFF
Private Const ERROR_ALREADY_EXISTS = 183&

Private Const QS_HOTKEY& = &H80
Private Const QS_KEY& = &H1
Private Const QS_MOUSEBUTTON& = &H4
Private Const QS_MOUSEMOVE& = &H2
Private Const QS_PAINT& = &H20
Private Const QS_POSTMESSAGE& = &H8
Private Const QS_SENDMESSAGE& = &H40
Private Const QS_TIMER& = &H10
Private Const QS_MOUSE& = (QS_MOUSEMOVE Or QS_MOUSEBUTTON)
Private Const QS_INPUT& = (QS_MOUSE Or QS_KEY)
Private Const QS_ALLINPUT& = (QS_SENDMESSAGE Or QS_PAINT _
              Or QS_TIMER Or QS_POSTMESSAGE Or QS_MOUSEBUTTON _
              Or QS_MOUSEMOVE Or QS_HOTKEY Or QS_KEY)

Private Declare Function CreateWaitableTimer Lib "kernel32" _
    Alias "CreateWaitableTimerA" (ByVal lpSemaphoreAttributes _
    As Long, ByVal bManualReset As Long, ByVal lpName As String) _
    As Long

Private Declare Function SetWaitableTimer Lib "kernel32" ( _
    ByVal hTimer As Long, lpDueTime As FILETIME, ByVal lPeriod _
    As Long, ByVal pfnCompletionRoutine As Long, _
    ByVal lpArgToCompletionRoutine As Long, _
    ByVal fResume As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal _
    hObject As Long) As Long

Private Declare Function MsgWaitForMultipleObjects Lib _
    "user32" (ByVal nCount As Long, pHandles As Long, ByVal _
    fWaitAll As Long, ByVal dwMilliseconds As Long, ByVal _
    dwWakeMask As Long) As Long

Public Sub Wait(lNumberOfSeconds As Long)
  Dim ft As FILETIME
  Dim lBusy As Long
  Dim lRet As Long
  Dim dblDelay As Double
  Dim dblDelayLow As Double
  Dim dblUnits As Double
  Dim hTimer As Long

  hTimer = CreateWaitableTimer(0, True, vbNullChar)

  If Err.LastDllError = ERROR_ALREADY_EXISTS Then
     '
  Else
    ft.dwLowDateTime = -1
    ft.dwHighDateTime = -1
    lRet = SetWaitableTimer(hTimer, ft, 0, 0, 0, 0)
  End If

  dblUnits = CDbl(&H10000) * CDbl(&H10000)
  dblDelay = CDbl(lNumberOfSeconds) * 1000 * 10000

  ft.dwHighDateTime = -CLng(dblDelay / dblUnits) - 1
  dblDelayLow = -dblUnits * _
        (dblDelay / dblUnits - Fix(dblDelay / dblUnits))

  If dblDelayLow < CDbl(&H80000000) Then
    dblDelayLow = dblUnits + dblDelayLow
    ft.dwHighDateTime = ft.dwHighDateTime + 1
  End If

  ft.dwLowDateTime = CLng(dblDelayLow)
  lRet = SetWaitableTimer(hTimer, ft, 0, 0, 0, False)

  Do
    lBusy = MsgWaitForMultipleObjects(1, hTimer, False, _
          INFINITE, QS_ALLINPUT&)
    DoEvents
  Loop Until lBusy = WAIT_OBJECT_0

  CloseHandle hTimer
End Sub
 
Code im Codebereich der Form
 
Option Explicit

Private Declare Sub Sleep Lib "kernel32" ( _
      ByVal dwMilliseconds As Long)

Private Sub Command1_Click()
  Command1.Enabled = False
  Wait 5
  Command1.Enabled = True
End Sub

Private Sub Command2_Click()
  Command2.Enabled = False
  Sleep 5000
  Command2.Enabled = True
End Sub

Private Sub Timer1_Timer()
  ProgressBar1.Value = ProgressBar1.Value + 1
  If ProgressBar1.Value >= ProgressBar1.Max Then
    ProgressBar1.Value = 0
  End If
End Sub
 
Links zum Thema
How To Use SetWaitableTimer With Visual Basic

Windows-Version
95
98
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (5 kB) Downloads bisher: [ 785 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Sonntag, 3. Juli 2011