Description
Some people want the ease of use from a timer but want the accuracy from a game loop. Well this code here does just that. Use it like a timer, but expect high precision accuracy that automatically matches the computer monitor's refresh rate.
Prerequisites
Simply add the System.Management DLL to your references. If you computer does not support the QueryPerformance API's then an exception will be thrown.
Code
Acknowledgements
Jacob Roman - Showing me the QueryPerformance API's
TnTinMN - Helping with getting the refresh rate of the monitor
Some people want the ease of use from a timer but want the accuracy from a game loop. Well this code here does just that. Use it like a timer, but expect high precision accuracy that automatically matches the computer monitor's refresh rate.
Prerequisites
Simply add the System.Management DLL to your references. If you computer does not support the QueryPerformance API's then an exception will be thrown.
Code
Code:
Option Strict On
Option Explicit On
<System.ComponentModel.DefaultEvent("Tick")> _
Public Class GameLoop
Inherits System.ComponentModel.Component
Private frequency As Long
Private waitThread As Threading.Thread
#Region "Api"
Private Declare Function QueryPerformanceCounter Lib "kernel32" (ByRef lpPerformanceCount As Long) As Integer
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (ByRef lpFrequency As Long) As Integer
#End Region
#Region "Events"
Public Event Tick(ByVal sender As Object, ByVal e As EventArgs)
#End Region
#Region "Methods"
Private Sub CheckCompatibility()
Dim test As Long
If Not CBool(QueryPerformanceCounter(test)) Then
Throw New Exception("High-resolution counter is not supported for this computer.")
End If
End Sub
Private Function GetRefreshRate() As Double
Dim query As System.Management.SelectQuery = New System.Management.SelectQuery("Win32_VideoController")
For Each mo As System.Management.ManagementObject In New System.Management.ManagementObjectSearcher(query).Get
Dim currentRate As Object = mo("CurrentRefreshRate")
If currentRate IsNot Nothing Then
Return CDbl(currentRate)
End If
Next
Return Nothing
End Function
Public Sub Start()
pEnabled = True
waitThread = New Threading.Thread(AddressOf Wait)
waitThread.IsBackground = True
waitThread.Start()
End Sub
Public Sub [Stop]()
Me.Enabled = False
End Sub
Private Sub Wait()
Dim counter1, counter2 As Long
QueryPerformanceCounter(counter1)
Do
QueryPerformanceCounter(counter2)
Loop Until (counter2 - counter1) / (frequency / 1000) >= 1000 / rate
RaiseEvent Tick(Me, EventArgs.Empty)
Console.WriteLine((counter2 - counter1) / (frequency / 1000))
If pEnabled Then
waitThread = New Threading.Thread(AddressOf Wait)
waitThread.IsBackground = True
waitThread.Start()
End If
End Sub
#End Region
#Region "New Constructor"
Sub New()
Call CheckCompatibility()
QueryPerformanceFrequency(frequency)
rate = GetRefreshRate()
End Sub
#End Region
#Region "Properties"
Private pEnabled As Boolean
<System.ComponentModel.Description("Gets or sets a value indicating whether the GameLoop should raise the Tick event.")> _
Public Property Enabled() As Boolean
Get
Return pEnabled
End Get
Set(ByVal value As Boolean)
If pEnabled <> value Then
pEnabled = value
If pEnabled Then RaiseEvent Tick(Me, EventArgs.Empty)
End If
End Set
End Property
Private rate As Double
<System.ComponentModel.Description("Gets or sets a value indicating the refresh rate of the computer's monitor.")> _
Public ReadOnly Property RefreshRate() As Double
Get
Return rate
End Get
End Property
#End Region
End ClassJacob Roman - Showing me the QueryPerformance API's
TnTinMN - Helping with getting the refresh rate of the monitor