VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "API_Timer" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False '=========== Precise timer wrapper ============= ' Shared module version: 20210528 ' Tested in: ' Depends on: ' Required reference: Option Explicit Private Type BigInt lowPart As Long highPart As Long End Type Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As BigInt) As Long Private Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As BigInt) As Long Private Const TWO_32 = 4294967296# Private start_ As BigInt Private finish_ As BigInt Private frequency_ As Double Public Function Start() Call QueryPerformanceCounter(start_) End Function ' Time elapsed in milliseconds Public Property Get TimeElapsed() As Double Dim crStart As Double Dim crStop As Double QueryPerformanceCounter finish_ crStart = BigInt2Double(start_) crStop = BigInt2Double(finish_) TimeElapsed = 1000# * (crStop - crStart) / frequency_ End Property Public Property Get TimeStr() As String TimeStr = VBA.Format(TimeElapsed, "# ##0.###") & " ms" End Property ' ==== Private Function BigInt2Double(theInt As BigInt) As Double Dim lowPart As Double lowPart = theInt.lowPart If lowPart < 0 Then lowPart = lowPart + TWO_32 End If BigInt2Double = theInt.highPart * TWO_32 + lowPart End Function Private Sub Class_Initialize() Dim freq As BigInt Call QueryPerformanceFrequency(freq) frequency_ = BigInt2Double(freq) End Sub