为一个网友写的真正的精确到毫秒级的动态秒表。顺便散分！

Private Sub Command1_Click()

  Dim i As Long, t As Double, t2 As Double, x As Boolean

  Dim ts(19) As Double

  While i < 20

    x = True

    t = Timer

    Do While x

      t2 = Timer

      If t2 > t Then

        ts(i) = t2 - t

        t = t2

        x = False

      End If

    Loop

    i = i + 1

  Wend

  For i = 0 To 19

    Debug.Print ts(i) * 1000000

  Next

End Sub

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Sub Command1_Click()

  Dim i As Long, t As Double, t2 As Double, x As Boolean

  While i < 20

    x = True

    t = GetTickCount

    Do While x

      t2 = GetTickCount

      If t2 > t Then

        Debug.Print t

        t = t2

        x = False

      End If

    Loop

    i = i + 1

  Wend

End Sub

Private Type LARGE_INTEGER

    lowpart As Long

    highpart As Long

End Type



Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long

Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long



Private Sub Command1_Click()

  Dim i As Long, t As LARGE_INTEGER, t2 As LARGE_INTEGER, x As Boolean, tc As LARGE_INTEGER

  Dim ts(19) As Double

  QueryPerformanceFrequency tc

  Debug.Print tc.highpart, tc.lowpart

  While i < 20

    QueryPerformanceCounter t

    x = True

    Do While x

      QueryPerformanceCounter t2

      If (t2.lowpart <> t.lowpart) Then

        ts(i) = (t2.lowpart - t.lowpart)

        t = t2

        x = False

      End If

    Loop

    i = i + 1

  Wend

  For i = 0 To 19

    Debug.Print ts(i) / tc.lowpart * 1000000 '转化成微秒单位

  Next

End Sub

'Example Name:Performance Counter

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 Sub Form_Load()

    'KPD-Team 2001

    'URL: http://www.allapi.net/

    'E-Mail: KPDTeam@Allapi.net

    Dim T As Long, liFrequency As LARGE_INTEGER, liStart As LARGE_INTEGER, liStop As LARGE_INTEGER

    Dim cuFrequency As Currency, cuStart As Currency, cuStop As Currency

    'Retrieve the frequency of the performance counter

    If QueryPerformanceFrequency(liFrequency) = 0 Then

        MsgBox "Your hardware doesn't support a high-resolution performance counter!", vbInformation

    Else

        'convert the large integer to currency

        cuFrequency = LargeIntToCurrency(liFrequency)

        'retrieve tick count

        QueryPerformanceCounter liStart

        'do something

        For T = 0 To 100000

            DoEvents

        Next T

        'retrieve tick count

        QueryPerformanceCounter liStop

        'convert large integers to currency's

        cuStart = LargeIntToCurrency(liStart)

        cuStop = LargeIntToCurrency(liStop)

        'calculate how many seconds passed, and show the result

        MsgBox "Time: " + CStr((cuStop - cuStart) / cuFrequency) + " seconds"

    End If

End Sub

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