Particularité de la function Sleep
Bonjour,
Il semble que les fonctions Sleep et SleepEx ne soient pas linéaires !!!
Cela n'est pas très important dans le cas d'un appel unique en utilisant un délai long
mais peu poser problème lors d'appels répétifs avec un délai court pour peu le temps cumulé doit correspondre à une valeur recherchée.
Afin d'identifier d'éventuelles différences en fonctions de la machine utilisée
(ce dont je doute, il est plus probable que ce soit une particularité liée au développement des fonctions)
il serait intéressant d'exécuter le code ci-dessous sur différentes machines puis coller dans ce thread les résultats en indiquant l'os utilisée.
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
| Option Explicit
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
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function SleepEx Lib "kernel32" (ByVal dwMilliseconds As Long, ByVal bAlertable As Long) As Long
Private Sub Command1_Click()
Dim x As Long, y As Long, ret As String, t As Currency
Dim frequency As Currency, liStart As LARGE_INTEGER, liStop As LARGE_INTEGER, cStart As Currency, cStop As Currency
Const k0 As Long = 0
Const k1 As Long = 250
Me.ProgressBar1.Min = k0
Me.ProgressBar1.Max = k1
frequency = GetFrequency()
If frequency <> 0 Then
For x = k0 To k1
QueryPerformanceCounter liStart
SleepEx x, False
QueryPerformanceCounter liStop
cStart = LargeInteger2Currency(liStart)
cStop = LargeInteger2Currency(liStop)
t = (cStop - cStart) / frequency
ret = ret & IIf(ret <> "", vbCrLf, "") & x & vbTab & t
Me.ProgressBar1.Value = x
Next
End If
Clipboard.Clear
Clipboard.SetText vbtab & frequency & vbCrLf & ret
MsgBox "Test End"
Unload Me
End Sub
Private Function GetFrequency() As Currency
Dim liFrequency As LARGE_INTEGER
If QueryPerformanceFrequency(liFrequency) <> 0 Then GetFrequency = LargeInteger2Currency(liFrequency)
End Function
Private Function LargeInteger2Currency(liInput As LARGE_INTEGER) As Currency
CopyMemory LargeInteger2Currency, liInput, LenB(liInput)
LargeInteger2Currency = LargeInteger2Currency * 10000
End Function |
Le code est à exécuter depuis une feuille contenant un bouton de commande et un progressbar.
Il demande autant de temps d'exécution (environ 30") en runtime ou compilé.
Le résultat se trouvant dans le presse papier, il suffit d'effectuer un ctrl V pour le coller et indiquer l'OS utilisé.
Merci de votre concours.
