Newsgroup: it.comp.lang.visual-basic
Titolo: [!]Classe per timer ad accurata precisione

Basandomi sull'idea di Christopher D. Lucas (quello delle stringhe
mappate), e sul codice del KPDTeam di Allapi.net, ho scritto una classe
che permette di misurare intervalli di tempo abbastanza accuratamente e
semplicemente.
Spero possa servire a qualcuno
Sorgente della classe "NewPrecisionTimer":
Option Explicit
' termoPilucco - LamerSoft Italy 2004
' based on
' KPD-Team 2001
' URL: 
http://www.allapi.net/
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 liFrequency As LARGE_INTEGER
Private liStart As LARGE_INTEGER
Private liStop As LARGE_INTEGER
Private cuFrequency As Currency
Private cuStart As Currency
Private cuStop As Currency
Sub start()
Call QueryPerformanceFrequency(liFrequency)
'convert the large integer to currency
cuFrequency = LargeIntToCurrency(liFrequency)
'retrieve tick count
QueryPerformanceCounter liStart
End Sub
Sub stopTimer()
'retrieve tick count
QueryPerformanceCounter liStop
'convert large integers to currency's
cuStart = LargeIntToCurrency(liStart)
cuStop = LargeIntToCurrency(liStop)
End Sub
Function strElapsedSeconds(Optional decimals As Long = 3) As String
'calculate how many seconds passed, and show the result (string version)
strElapsedSeconds = Round(((cuStop - cuStart) / cuFrequency), decimals) & _
                    " sec."
End Function
Function elapsedSeconds() As Double
'calculate how many seconds passed, and show the result
elapsedSeconds = ((cuStop - cuStart) / cuFrequency)
End Function
Private Function LargeIntToCurrency(liInput As LARGE_INTEGER) As Currency
    'copy 8 bytes from the large integer to an ampty currency
    CopyMemory LargeIntToCurrency, liInput, LenB(liInput)
    'adjust it
    LargeIntToCurrency = LargeIntToCurrency * 10000
End Function
'<------------------ fine sorgente classe
Sorgente form di prova:
Aggiungere oggetto command1
Option Explicit
Private Sub command1_Click()
Dim a As Long
Dim myTimer As NewPrecisionTimer
Set myTimer = New NewPrecisionTimer
myTimer.start
For a = 1 To 100000
    DoEvents
Next
myTimer.stopTimer
MsgBox myTimer.strElapsedSeconds ' valore formattato
MsgBox myTimer.elapsedSeconds  ' valore puro
Set myTimer = Nothing
End Sub
-- 
questo articolo e` stato inviato via web dal servizio gratuito 
http://www.newsland.it/news
 segnala gli abusi ad 
ab...@newsland.it

 Spero possa servire a qualcuno
...
Proveremo, grazie.
PS: Ma se termo non lavorasse per la PA (annessi/connessi) cosa sarebbe ?
;-)

;-)
A dire il vero la classe che "ho scritto" è praticamente tutto codice di Allapi,
mentre l'idea di creare una classe timer è di Christopher D. Lucas...
Visto che la classe scritta da quest'ultimo funzionava bene solo sui Pc del suo
tempo, ho preso l'idea dell'uno e il codice degli altri e li ho messi insieme :)
Da dimostrare che la cosa funzioni bene :O
termoPilucco

 li ho messi insieme :) Da dimostrare che la cosa funzioni bene :O
Ecco un classico esempio di cosa si intenda per "fare l'indiano" :-P

 End Sub
Solo un appunto:
dato che la frequenza del contatore (che oltretutto sui processori
relativamente recenti corrisponde a quella del processore stesso) è un
dato che non varia nel tempo, sarebbe meglio spostare la lettura di
questa frequenza fuori dalla start, perché conunque è una chiamata ad
una funzione di sistema che "consuma" (per quanto poco possa essere) il 
suo tempo, tempo che va incorrettamente ad aggiungersi al tempo di
esecuzione di quello che viene eseguito dopo.
Sono d'accordo che spessissimo questo sarà trascurabile però, dato che
se ne può fare tranquillamente a meno (piazzandolo nel
pseudo-costruttore della classe - Class_Initialize) conviene farlo.
Ciao.
-- 
BSD is for UNIX lovers -- linux is for Windows haters.