VB 5/6-Tipp 0746: QueryPerformance und StopWatch mit Variablentyp Currency
von Oliver Meyer
Beschreibung
Tipp 11 demonstriert die Verwendung der API-Funktion QueryPerformaceCounter, bzw. -Frequency. Der vorliegende Tipp soll kein Ersatz für Tipp 11 sein, sondern aufzeigen, dass es unter VB6 nicht erforderlich ist, einen selbstdefinierten Datentyp wie LONG_INTEGER zu verwenden. Der Datentyp Currency ist geradezu ideal für die Verwendung mit der Funktion QueryPerformanceCounter und/oder QueryPerformanceFrequency:
Der Datentyp Currency in VB6 ist ein 64Bit-Datentyp mit einem Festpunktanteil. Beim Bitwert &H2710 (bzw decimal 10000) ist der Wert 1 definiert. Der kleinste positive Wert des Datentyps Currency ist 0.0001. Da die Einheit Ticks ebenfalls den Parameter 10000 beinhaltet, ist der VB-Datentyp Currency genau der richtige Datentyp für Zeitmessungen mit der QueryPerformance-API.
Schwierigkeitsgrad: | Verwendete API-Aufrufe: QueryPerformanceCounter, QueryPerformanceFrequency, RtlMoveMemory | Download: |
'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 Projekt1.vbp ------------- '--------- Anfang Formular "Form1" alias Form1.frm --------- ' Steuerelement: Schaltfläche "BtnReset" ' Steuerelement: Schaltfläche "BtnStop" ' Steuerelement: Schaltfläche "BtnStart" Option Explicit 'hier nur ein TestTreiber für die Stopp-Uhr-Klasse StopWatch Private mSW As StopWatch Private Sub Form_Load() Set mSW = New StopWatch End Sub Private Sub BtnStart_Click() Call mSW.Start End Sub Private Sub BtnStop_Click() Call mSW.SStop Dim s As String s = s & "StopWatch.Frequency : " & StopWatch.Frequency & vbCrLf s = s & "Stopwatch.GetTimestamp : " & StopWatch.GetTimestamp & vbCrLf s = s & "mSW.ElapsedTicks : " & mSW.ElapsedTicks & vbCrLf s = s & "mSW.ElapsedMilliseconds: " & mSW.ElapsedMilliseconds & vbCrLf s = s & "mSW.Elapsed : " & mSW.ElapsedToString & vbCrLf MsgBox (s) End Sub Private Sub BtnReset_Click() Call mSW.Reset MsgBox "StoppUhr zurückgesetzt! " & CStr(mSW.ElapsedMilliseconds) & " ms" End Sub '---------- Ende Formular "Form1" alias Form1.frm ---------- '------ Anfang Klasse "StopWatch" alias StopWatch.cls ------ Option Explicit 'Class StopWatch 'Der Datentyp Currency in VB ist ein 64Bit-Datentyp mit einem 'Festpunktanteil. D.h. beim Bitwert &H2710 (bzw decimal 10000) 'ist der Wert 1 definiert, bzw. der kleinste positive Wert des 'Datentyps Currency ist 0.0001 'Da die Einheit Ticks ebenfalls den Parameter 10000 beinhaltet, 'ist der VB-Datentyp Currency genau der richtige Datentyp für 'Zeitmessungen mit der QueryPerformance-API Private mFrequency As Currency Private mIsHighResolution As Boolean Private mIsRunning As Boolean Private mStartTimeStamp As Currency Private mElapsed As Currency Private mTickFrequency As Double 'In der gleihnamigen VB.Net-Klasse wird hier der Datentyp Long, 'bzw Int64 verwendet. 'Der Korrekturfaktor für den Datentyp Currency Private Const CurCorrect As Long = 10000 Private Const TicksPerMillisecond As Long = 10000 / CurCorrect '&H2710 Private Const TicksPerSecond As Long = 10000000 / CurCorrect '&H989680 Private Declare Function QueryPerformanceCounter Lib "kernel32" ( _ ByRef lpPerformanceCount As Currency) As Long Private Declare Function QueryPerformanceFrequency Lib "kernel32" ( _ ByRef lpFrequency As Currency) As Long Private Declare Sub RtlMoveMemory Lib "kernel32" ( _ ByRef pDst As Any, ByRef pSrc As Any, ByVal bytLength As Long) Private Sub Class_Initialize() If Not (QueryPerformanceFrequency(mFrequency) = 1) Then mIsHighResolution = False mFrequency = TicksPerSecond mTickFrequency = 1 Else mIsHighResolution = True mTickFrequency = (TicksPerSecond / CDbl(mFrequency)) End If End Sub 'Public Function GetTimestamp() As Currency 'Long 'LongInt Public Function GetTimestamp() As Currency GetTimestamp = pGetTimestamp * CurCorrect End Function Private Function pGetTimestamp() As Currency If mIsHighResolution Then Call QueryPerformanceCounter(pGetTimestamp) Else pGetTimestamp = DateTime.Now End If End Function Public Sub Start() If Not mIsRunning Then mStartTimeStamp = pGetTimestamp mIsRunning = True End If End Sub Public Function StartNew() As StopWatch Set StartNew = New StopWatch Call StartNew.Start End Function Public Sub SStop() If IsRunning Then Dim c As Currency: c = (pGetTimestamp - mStartTimeStamp) mElapsed = (mElapsed + c) mIsRunning = False End If End Sub Public Sub Reset() mElapsed = 0 mIsRunning = False mStartTimeStamp = 0 End Sub 'Shared-Member Properties Public Property Get Frequency() As Currency 'Diese Multiplikation mit CurCorrect ist nur dazu da, die Klasse 'nach außen hin konsistent zu halten mit der gleichnamigen Klasse 'aus dem .NETFX Frequency = mFrequency * CurCorrect End Property Public Property Get IsHighResolution() As Boolean IsHighResolution = mIsHighResolution End Property ' #################### ' Public Properties ' #################### ' Public Property Get ElapsedToString() As String 'TimeSpan ElapsedToString = TimeSpanToString(GetElapsedDateTimeTicks) End Property Private Function TimeSpanToString(ByVal ticks As Currency) As String Dim b As String Dim h As Long, m As Long, s As Long, n As Long Dim days As Long: days = CInt((ticks / 86400000)) Dim time As Currency: time = (ticks Mod 86400000) If (ticks < 0) Then b = b & "-" days = -days time = -time End If If (days <> 0) Then b = b & CStr(days) & "." End If 'Stunden h = CInt(((time \ 3600000) Mod 24)) b = b & IntToString(h, 2) & ":" 'Minuten m = CInt(((time \ 60000) Mod 60)) b = b & IntToString(m, 2) & ":" 'Sekunden s = CInt(((time \ 1000) Mod 60)) b = b & IntToString(s, 2) n = (ticks - (CCur(h) * CCur(3600000)) _ - (CCur(m) * CCur(60000)) _ - (CCur(s) * CCur(1000))) * 10000 If (n <> 0) Then b = b & "." b = b & IntToString(n, 7) End If TimeSpanToString = b End Function Private Function IntToString(ByVal n As Long, ByVal digits As Long) As String Dim l As Long IntToString = CStr(n) l = Len(IntToString) If l < digits Then IntToString = String$(digits - l, "0") & IntToString End Function Public Property Get ElapsedMilliseconds() As Currency 'Long 'LongInt ElapsedMilliseconds = GetElapsedDateTimeTicks / TicksPerMillisecond End Property Public Property Get ElapsedTicks() As Currency 'As Long 'LongInt ElapsedTicks = GetRawElapsedTicks * CurCorrect End Property Public Property Get IsRunning() As Boolean IsRunning = mIsRunning End Property ' #################### ' Private Functions ' #################### ' Private Function GetElapsedDateTimeTicks() As Currency Dim rawElapsedTicks As Currency: rawElapsedTicks = GetRawElapsedTicks If mIsHighResolution Then Dim d As Double: d = CDbl(rawElapsedTicks) d = (d * mTickFrequency) GetElapsedDateTimeTicks = CCur(d) Else GetElapsedDateTimeTicks = rawElapsedTicks End If End Function Private Function GetRawElapsedTicks() As Currency Dim Elapsed As Currency: Elapsed = mElapsed If mIsRunning Then Dim c As Currency: c = (GetTimestamp - mStartTimeStamp) Elapsed = (Elapsed + c) End If GetRawElapsedTicks = Elapsed End Function '------- Ende Klasse "StopWatch" alias StopWatch.cls ------- '------- Anfang Modul "ModSystem" alias ModSystem.bas ------- Option Explicit Public StopWatch As New StopWatch '-------- Ende Modul "ModSystem" alias ModSystem.bas -------- '-------------- Ende Projektdatei Projekt1.vbp --------------
Tipp-Kompatibilität:
Windows/VB-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
Ihre Meinung
Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.