High Resolution Timer....

Hi Guys,
I need to know how to write a High resolution timer in VB like the one in Impulse Studio (Ingenuware). I tried the API Settimer and Kill timer but it's same like the Ordinary VB timer. I found no difference between them. Any help please. Thnx in advance...

What exactly do you mean by "High resolution timer"?

Here's a high resolution timer cls module - shows the timeGetTime api call. Parksie posted this a while back.

Code:

---

Option Explicit

' No need to use GetPerformanceCounter() because this
' will be accurate to the highest timer resolution:
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Private Type tTimerData
  lInterval As Long
  sKey As String
  bEnabled As Boolean
  lLastTick As Long
End Type
Private m_tT() As tTimerData
Private m_iCount As Long
Private m_lPtr As Long

Public Event Timer(ByVal sKey As String)
Public Sub Connect(iTmr As ITimer)
  ' Do this is you want to get an implemented
  ' call:
  m_lPtr = ObjPtr(iTmr)
End Sub
Private Property Get ObjectFromPtr(ByVal lPtr As Long) As ITimer
Dim oTHis As ITimer
    CopyMemory oTHis, lPtr, 4
    Set ObjectFromPtr = oTHis
    CopyMemory oTHis, 0&, 4
End Property
Friend Sub FireTimer()
Dim i As Long
Dim lTick As Long
Dim lAmount As Long
Dim iTmr As ITimer
 
  If m_iCount > 0 Then
      If m_lPtr <> 0 Then
        ' Using implements
        Set iTmr = ObjectFromPtr(m_lPtr)
        lTick = timeGetTime()
        For i = 1 To m_iCount
            If m_tT(i).bEnabled Then
              lAmount = (lTick - m_tT(i).lLastTick)
              If lAmount >= m_tT(i).lInterval Or lAmount < 0 Then
                  m_tT(i).lLastTick = lTick
                  iTmr.Timer m_tT(i).sKey
              End If
            End If
        Next i
      Else
        ' using events
        lTick = timeGetTime()
        For i = 1 To m_iCount
            If m_tT(i).bEnabled Then
              lAmount = (lTick - m_tT(i).lLastTick)
              If lAmount >= m_tT(i).lInterval Or lAmount < 0 Then
                  m_tT(i).lLastTick = lTick
                  RaiseEvent Timer(m_tT(i).sKey)
              End If
            End If
        Next i
      End If
  End If
End Sub
Public Property Get Count() As Long
  Count = m_iCount
End Property
Public Function Add(ByVal sKey As String, Optional ByVal lInterval As Long = 10, Optional ByVal bEnabled As Boolean = False) As Long
  If Not (Exists(sKey)) Then
      m_iCount = m_iCount + 1
      ReDim Preserve m_tT(1 To m_iCount) As tTimerData
      With m_tT(m_iCount)
        .sKey = sKey
        .lInterval = lInterval
        .bEnabled = bEnabled
      End With
      If m_iCount = 1 Then
        StartTimer
        AddObject Me
      End If
  End If
End Function
Public Sub Remove(ByVal vKey As Variant)
Dim lIndex As Long
Dim i As Long
  lIndex = Index(vKey)
  If (lIndex > 0) Then
      If (m_iCount > 1) Then
        For i = lIndex To m_iCount - 1
            LSet m_tT(i) = m_tT(i + 1)
        Next i
        m_iCount = m_iCount - 1
        ReDim Preserve m_tT(1 To m_iCount) As tTimerData
      Else
        Erase m_tT
        m_iCount = 0
        StopTimer
        RemoveObject Me
      End If
  End If
End Sub
Public Property Get Exists(ByVal sKey As String) As Boolean
Dim i As Long
  For i = 1 To m_iCount
      If (m_tT(i).sKey = sKey) Then
        Exists = True
        Exit For
      End If
  Next i
End Property
Public Property Get Interval(ByVal vKey As Variant) As Long
Dim lIndex As Long
  lIndex = Index(vKey)
  If (lIndex > 0) Then
      Interval = m_tT(lIndex).lInterval
  End If
End Property
Public Property Let Interval(ByVal vKey As Variant, ByVal lInterval As Long)
Dim lIndex As Long
  lIndex = Index(vKey)
  If (lIndex > 0) Then
      m_tT(lIndex).lInterval = lInterval
  End If
End Property
Public Property Get Enabled(ByVal vKey As Variant) As Boolean
Dim lIndex As Long
  lIndex = Index(vKey)
  If (lIndex > 0) Then
      Enabled = m_tT(lIndex).bEnabled
  End If
End Property
Public Property Let Enabled(ByVal vKey As Variant, ByVal bEnabled As Boolean)
Dim lIndex As Long
  lIndex = Index(vKey)
  If (lIndex > 0) Then
      m_tT(lIndex).bEnabled = bEnabled
      If (bEnabled) Then
        m_tT(lIndex).lLastTick = timeGetTime()
      End If
  End If
End Property
Public Property Get Index(ByVal vKey As Variant) As Long
Dim i As Long
  If IsNumeric(vKey) Then
      If vKey > 0 And vKey <= m_iCount Then
        Index = vKey
        Exit Property
      End If
  Else
      For i = 1 To m_iCount
        If m_tT(i).sKey = vKey Then
            Index = i
            Exit Property
        End If
      Next i
  End If
  Err.Raise 9, App.EXEName & ".cHiResTimer"
End Property
Private Sub Class_Terminate()
  StopTimer
  RemoveObject Me
End Sub

---

PS - chrisjk

high resolution timer is one that is extremely accurate, ie., fine resolution.

I thought so, but how fine is fine? Things like GetTickCount are pretty fine (milliseconds). Is fine finer than milliseconds?

I think this is the highest resolution you can get:
http://support.microsoft.com/support.../Q172/3/38.asp