BetterMicroTimer -TizzyT

Imports System.Runtime.InteropServices
Imports System.Threading

Public Class MicroTimer
    Public Shared Event Elapsed()

    Private Const TwoThirds As Decimal = 2D / 3D
    Private Shared ReadOnly MicroRunning As New Mutex(True)
    Private Shared ReadOnly MicroWait As New AutoResetEvent(False)
    Private Shared ReadOnly WaitThread As Thread
    Private Shared TicksPerMillisecond As Decimal = Stopwatch.Frequency / 1000D
    Private Shared TicksPerInterval As Decimal
    Private Shared NextTime As Decimal
    Private Shared Milliseconds As Integer = 0
    Private Shared Running As Boolean = False

    Shared Sub New()
        WaitThread = New Thread(Sub()
                                    While True
                                        MicroRunning.WaitOne() 'Waits until the MicroTimer is started
                                        Milliseconds = Math.Round(((NextTime - Stopwatch.GetTimestamp) / TicksPerMillisecond) - TwoThirds) 'Computes the number of milliseconds to wait (for efficiency)
                                        If Milliseconds > 1 Then 'If the computed milliseconds to wait is greater than 1
                                            timeSetEvent(Milliseconds, 0,
                                                         New TimerEventDel(Sub(ByVal id As UInteger, ByVal msg As UInteger, ByVal user As IntPtr, ByVal dw1 As IntPtr, ByVal dw2 As IntPtr)
                                                                               MicroWait.Set() 'Continue the while loop
                                                                               Do : Loop Until timeKillEvent(id) = MMRESULT.MMSYSERR_NOERROR 'Keep trying to kill this event
                                                                           End Sub),
                                                         IntPtr.Zero, 0)
                                            MicroWait.WaitOne() 'Wait a number of whole milliseconds before starting the sub millisecond poll
                                        End If
                                        While Stopwatch.GetTimestamp < NextTime : End While 'Spin until the next fire time is reached
                                        Do
                                            RaiseEvent Elapsed() 'Fire elapsed event
                                            NextTime += TicksPerInterval 'Increments the NextTime by the interval amount
                                        Loop While Running AndAlso NextTime < Stopwatch.GetTimestamp 'As long as the timer is behind it will keep firing until it is caught up
                                        MicroRunning.ReleaseMutex()
                                    End While
                                End Sub) With {.Priority = ThreadPriority.Highest, .IsBackground = True}
        WaitThread.Start()
    End Sub

    Public Shared Sub Start()
        Running = True
        NextTime = Stopwatch.GetTimestamp 'Computes the next time the MicroTimer will fire
        MicroRunning.ReleaseMutex()
    End Sub
    Public Shared Sub [Stop]()
        Running = False
        MicroRunning.WaitOne()
    End Sub

    Public Shared Function Interval() As Decimal
        Return TicksPerInterval
    End Function
    Public Shared Function Interval(ByVal NewIntervalTicks As ULong) As Decimal
        Dim CrntInterval As Decimal = TicksPerInterval
        TicksPerInterval = NewIntervalTicks
        Return CrntInterval
    End Function
    Public Shared Function Interval(ByVal NewIntervalTicks As Decimal) As Decimal
        Dim CrntInterval As Decimal = TicksPerInterval
        TicksPerInterval = NewIntervalTicks
        Return CrntInterval
    End Function
    Public Shared Function Interval(ByVal NewIntervalMilliseconds As UInteger) As Decimal
        Dim CrntInterval As Decimal = TicksPerInterval
        TicksPerInterval = NewIntervalMilliseconds * TicksPerMillisecond
        Return CrntInterval
    End Function
    Public Shared Function Interval(ByVal NewIntervalMilliseconds As Double) As Decimal
        Dim CrntInterval As Decimal = TicksPerInterval
        TicksPerInterval = NewIntervalMilliseconds * TicksPerMillisecond
        Return CrntInterval
    End Function

    <DllImport("winmm.dll")>
    Private Shared Function timeBeginPeriod(ByVal msec As UInteger) As MMRESULT : End Function
    <DllImport("winmm.dll")>
    Private Shared Function timeEndPeriod(ByVal msec As UInteger) As MMRESULT : End Function
    <DllImport("winmm.dll")>
    Private Shared Function timeSetEvent(ByVal delay As UInteger, ByVal resolution As UInteger, ByVal handler As TimerEventDel, ByVal user As IntPtr, ByVal eventType As UInteger) As MMRESULT
    End Function
    <DllImport("winmm.dll")>
    Private Shared Function timeKillEvent(ByVal id As UInteger) As MMRESULT : End Function
    Private Delegate Sub TimerEventDel(ByVal id As UInteger, ByVal msg As UInteger, ByVal user As IntPtr, ByVal dw1 As IntPtr, ByVal dw2 As IntPtr)
    Private Enum MMRESULT
        MMSYSERR_NOERROR = 0
        MMSYSERR_ERROR = 1
        MMSYSERR_BADDEVICEID = 2
        MMSYSERR_NOTENABLED = 3
        MMSYSERR_ALLOCATED = 4
        MMSYSERR_INVALHANDLE = 5
        MMSYSERR_NODRIVER = 6
        MMSYSERR_NOMEM = 7
        MMSYSERR_NOTSUPPORTED = 8
        MMSYSERR_BADERRNUM = 9
        MMSYSERR_INVALFLAG = 10
        MMSYSERR_INVALPARAM = 11
        MMSYSERR_HANDLEBUSY = 12
        MMSYSERR_INVALIDALIAS = 13
        MMSYSERR_BADDB = 14
        MMSYSERR_KEYNOTFOUND = 15
        MMSYSERR_READERROR = 16
        MMSYSERR_WRITEERROR = 17
        MMSYSERR_DELETEERROR = 18
        MMSYSERR_VALNOTFOUND = 19
        MMSYSERR_NODRIVERCB = 20
        WAVERR_BADFORMAT = 32
        WAVERR_STILLPLAYING = 33
        WAVERR_UNPREPARED = 34
    End Enum
End Class