Originallement trouvé sur le ng microsoft.public.fr.vb
Utilise des API qui permettent de mesurer une différence de temps beaucoup plus infime que Timer ou GetTickCount
Une utilisation intéressante est de faire des tests de rapidité l'aglorithmes, ou de portion de code, pour optimiser son application.
Vous verrez la difference sur un simple for i = 1 to 100 : next lorsque i est de type variant et i de type integer !
J'ai codé en urgence un "WaitMicroseconde" qui est l'équivalent en plus préçis de Sleep.
Source / Exemple :
'========= Declarations =======
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long
' =========== SUBS =========
Public Function TestMyAlgo(AlgoParam1 As Long, Optional AlgoParam2 As Long = 0) As String
Dim curStart As LARGE_INTEGER
Dim curEnd As LARGE_INTEGER
Dim curFreq As LARGE_INTEGER
Dim fResult As Double
Dim sText As String
Dim TmpCalc As Boolean
QueryPerformanceFrequency curFreq 'relevé du "top par secondes"
QueryPerformanceCounter curStart 'relevé d'un top (début de mesure)
'TmpCalc = MonAgloEnTest(AlgoParam1)
WaitMicroSeconde 20
QueryPerformanceCounter curEnd 'relevé d'un autre top (fin de mesure)
'conversion du résultat inter-top en millisecondes
fResult = 1000 * (CDbl(curEnd.lowpart) - CDbl(curStart.lowpart)) / CDbl(curFreq.lowpart)
'formattage pour l'affichage
TestMyAlgo = Format(fResult, "#0.000000") & " ms"
End Function
Public Sub WaitMicroSeconde(Duree As Long)
'attend "duree" microsecondes.
'Des test montre que c'est = Duree + ou - x microsecondes...!
Dim curStart As LARGE_INTEGER
Dim curEnd As LARGE_INTEGER
Dim curFreq As LARGE_INTEGER
Dim WaitTop As Long
QueryPerformanceFrequency curFreq
QueryPerformanceCounter curStart
WaitTop = curStart.lowpart + Int(Duree * 3.38) '* Int(CDbl(curFreq.lowpart) / 894950)
Do
QueryPerformanceCounter curEnd
Loop Until curEnd.lowpart >= WaitTop
End Sub
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.