Option Explicit On

Public Class Form1
Dim x_Timer As New xtimer

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

x_Timer.Calibrieren()
End Sub

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
warten(5000)
End Sub

Public Sub warten (ByVal zeit)
' Wartet 'zeit' Millisekunden bis es zurück kommt


x_Timer.Start()
Do
x_Timer.Halt()
Beep()
Loop Until x_Timer.RunTime >= zeit

End Sub



End Class


Public Class xtimer

'Deklaration: Globale Klassen API-Typen
Private Structure LARGE_INTEGER
Dim Lo As Long
Dim Hi As Long
End Structure

'Deklaration: Globale Klassen API-Funktionen
Private Declare Function QueryPerformanceCounter Lib "kernel32" ( _
ByVal lpPerformanceCount As LARGE_INTEGER) As Long

Private Declare Function QueryPerformanceFrequency Lib "kernel32" ( _
ByVal lpFrequency As LARGE_INTEGER) As Long

'Deklaration: Globale Klassen-Variablen
Dim dblCalibrieren As Double

Dim udtStart As LARGE_INTEGER
Dim udtEnde As LARGE_INTEGER
Dim udtFreq As LARGE_INTEGER

Public Sub Calibrieren()
Call QueryPerformanceCounter(udtStart)
Call QueryPerformanceCounter(udtEnde)

dblCalibrieren = (D(udtEnde) - D(udtStart)) / D(udtFreq) * 1000
End Sub

Sub New()
Call QueryPerformanceFrequency(udtFreq)
End Sub

Public Sub Halt()
Call QueryPerformanceCounter(udtEnde)
End Sub

Public Sub Start()
Call QueryPerformanceCounter(udtStart)
End Sub

Public ReadOnly Property RunTime() As Double
Get
RunTime = (D(udtEnde) - D(udtStart)) / D(udtFreq) * 1000 - dblCalibrieren
End Get

End Property


Private Function D(ByVal udtX As LARGE_INTEGER) As Double
'Deklaration: Lokale Prozedur-Variablen
Dim dblHigh As Double
Dim dblLow As Double

dblLow = udtX.Lo
dblHigh = udtX.Hi

If dblLow < 0 Then
dblLow = 4294967296.0# + dblLow + 1
End If

If dblHigh < 0 Then
dblHigh = 4294967296.0# + dblHigh + 1
End If

D = dblLow + dblHigh * 4294967296.0#

End Function




End Class