Exaktes Timer Delay VB Programm für eine Exakte Zeit anhalten
Autor:   Peter Rettenbacher	Bewertung:     [ Jetzt bewerten ]	Views:  9.143
ohne Homepage	System:  WinNT, Win2k, WinXP, Vista, Win7	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 14 Bewertung insgesamt: nützlich Durchschnittliche Bewertung: 3.1 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Heute möchten wir Ihnen zeigen, wie man ein VB-Programm für eine absolut exakte Zeit anhalten kann. Hierzu verwenden wir zwei API-Funktionen, mit denen eine Zeitmessung im 10.000stel Sekundenbereich möglich ist.

Fügen Sie nachfolgenden Code in ein Modul:

' benötigte API-Deklarationen
Private Declare Function QueryPerformanceFrequency Lib "kernel32" ( _
  lpFrequency As Currency) As Long
 
Private Declare Function QueryPerformanceCounter Lib "kernel32" ( _
  lpPerformanceCount As Currency) As Long

Public Sub TimerDelay(DelaySekunden As Currency)
  Static DelayFreq As Currency
  Dim DelayTimer   As Currency
  Dim DelayTime1   As Currency
  Dim DelayTime2   As Currency
  Dim DelayTimeSum As Currency
 
  ' Initialisieren
  If DelayFreq = 0 Then
   QueryPerformanceFrequency DelayFreq
  End If
 
  ' ---------------------------------------------
  QueryPerformanceCounter DelayTimer
  DelayTime1 = DelayTimer / DelayFreq
  ' ----------------------------------------------
 
  Do
    QueryPerformanceCounter DelayTimer
    DelayTime2 = DelayTimer / DelayFreq
    DelayTimeSum = DelayTime2 - DelayTime1
 
    DoEvents
 
  Loop Until DelayTimeSum >= DelaySekunden
  ' ----------------------------------------------
End Sub

Beispiel:
Im nachfolgenden eine Schleife mit 10 Durchläufen, wobei jeder Durchlauf immer exakt 500 Millisekunden andauert.

' Beispiel
Dim i As Long
 
Do While i < 10
  i = i + 1
  Debug.Print i
  TimerDelay (0.5) ' Delay auf 0.5 Sekunden (0.001 = 1MS)
Loop