QueryPerformanceCounter-Funktion Diese Funktion ermittelt einen Zeitwert, der mehrmals pro Sekunde aktualisiert wird.
Betriebssystem:  Win95, Win98, WinNT 3.1, Win2000, WinME	Views:  11.802

Deklaration:

Declare Function QueryPerformanceCounter Lib "kernel32.dll"  ( _
  lpPerformanceCount As LARGE_INTEGER) As Long

Beschreibung:
Diese Funktion ermittelt einen Zeitwert, der mehrmals pro Sekunde aktualisiert wird. Die Anzahl der Aktualisierungen dieses Counters kannmit der QueryPerformanceFrequency-Funktion ermittelt werden.

Parameter:

lpPerformanceCount

Erwartet eine ULARGE_INTEGER-Struktur, die mit demermittelten Zeitwert gefüllt wird. Um diesen Wert zu extrahieren, müssenSie diese Struktur mit der MOVEMEMORY-Funktion in eine Currency-Variablekopieren und den dann darin enthaltenen Wert mit 10.000 multiplizieren.

Rückgabewert:
Ist die Funktion erfolgreich, so ist die Rückgabe ein Wert "ungleich 0", andernfalls wird derWert "0" zurückgegeben.

Beispiel:

Private Declare Function QueryPerformanceCounter Lib "kernel32.dll"  ( _
  lpPerformanceCount As ULARGE_INTEGER) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32.dll"  ( _
  lpFrequency As ULARGE_INTEGER) As Long
Private Declare Function SetPixelV Lib "gdi32.dll" ( _
  ByVal hdc As Long, _
   ByVal X As Long, _
  ByVal Y As Long, _
  ByVal crColor As Long) As Long
Private Declare Function SetPixel Lib "gdi32.dll" ( _
  ByVal hdc As Long, _
  ByVal X As Long, _
  ByVal Y As Long, _
  ByVal crColor As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32.dll" _
  Alias "RtlMoveMemory"  ( _
  Destination As Any, _
  Source As Any, _
  ByVal Length As Long)
 
Private Type ULARGE_INTEGER
  LowPart As Long
  HighPart As Long
End Type
 
Private CounterFreq As Currency
Private TmpUInt As ULARGE_INTEGER

' Funktion um eine ULARGE_INTEGER in eine Currency-Variable zu kopieren
Private Function UlargeToCurrency(ByRef ULarge As ULARGE_INTEGER) As Currency 
  Dim Retval As Long, TmpCur As Currency
 
  ' Ularge in Currency kopieren und mit 10000 Multiplizieren
  MoveMemory TmpCur, ULarge, 8
  UlargeToCurrency = TmpCur * 10000
End Function

' Counter Frequenz ermitteln
Private Sub Form_Load()
  Me.ScaleMode = vbPixels
 
  ' Ermitteln, ob ein Hochleistungs-Timer verfügbar ist
  Retval = QueryPerformanceFrequency(TmpUInt)
  If Retval = 0 Then
    MsgBox "Dieses System hat keinen Hochleistungs Zeitmesser"
    Command1(0).Enabled = False
    Command1(1).Enabled = False
    Exit Sub
  End If
 
  ' Umwandeln der 64-Bit-Integer in eine Currency-Variable
  CounterFreq = UlargeToCurrency(TmpUInt)
  Debug.Print "Hochleistungs Timer Frequenz: " & CounterFreq & " Counts  _
  pro Sekunde"
End Sub

' Zeit der SetPixel  & SetPixelV Füllvariante messen
Private Sub Command1_Click(Index As Integer)
  Dim Retval As Long
  Dim StartCur As Currency, EndCur As Currency
  Dim StartInt As ULARGE_INTEGER, EndInt As ULARGE_INTEGER
  Dim i As Long, j As Long
 
  ' Zeit vor dem Beginn der Funktion messen
  Retval = QueryPerformanceCounter(StartInt)
 
  ' Starten der verschiedenen Funktionen
  Select Case Index
  Case 0 ' SetPixel
    For i = 0 To Me.ScaleWidth
      For j = 0 To Me.ScaleHeight
 
        SetPixel Me.hdc, i, j, vbRed
 
      Next j
    Next i
  Case 1 ' SetPixelV
    For i = 0 To Me.ScaleWidth
      For j = 0 To Me.ScaleHeight
 
        SetPixelV Me.hdc, i, j, vbBlue
 
      Next j
    Next i
  End Select
 
  ' Zeit nach dem Beenden der Funktion messen
  Retval = QueryPerformanceCounter(EndInt)
 
  ' Umwandeln der Zeiten in ein Currency-Format
  StartCur = UlargeToCurrency(StartInt)
  EndCur = UlargeToCurrency(EndInt)
 
  MsgBox "Diese aktion dauerte " & CLng((EndCur - StartCur) /  _
  (CounterFreq / 1000)) & " Millisekunden.."
End Sub