Tutorial - Accurate Game Loop

This tutorial will show how to make an accurate game loop
using QueryPerformanceCounter API.

The first thing we need to do is to declare the API functions:

VB Code:

Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long

This counter can differ from machine to machine, that's why we
have to get the frequency of it using QueryPerformanceFrequency.

Now we need a variable telling if the loop is on or off.
We also need to know what to lock the FPS at.

VB Code:

Dim Running As Boolean
Cost FPS As Double = 61.3

I've set the FPS to 61.3 just so we can see the accuracy.

Now head on to the loop.
We will nead a few variables to keep track on time and interval in this loop:

VB Code:

Dim cTimer As Currency
Dim cTimer2 As Currency
Dim Freq As Currency
Dim Interval As Double

cTimer is used to get the time when running the game code.
cTimer2 is used to get the time just before the game code.
Freq is used to store the frequency value from the API.
Interval will store the time to wait for next tick based on the FPS and frequency.

The loop will start off by getting the frequency and calculating the interval.
Since this will be constant during the looping, we only need to do this once.

VB Code:

QueryPerformanceFrequency Freq
Interval = Freq / FPS

Now the loop will start.
It will start by checking if the Running boolean is set to True.
Then it will check if it's time to enter the game code part.
Last it will handle windows messages (DoEvents), or else the program will lock.

VB Code:

While Running
    QueryPerformanceCounter cTimer2 'get current time
    If cTimer2 >= cTimer + Interval Then 'compare current time with previous time and see if enough time has passed
        Me.Caption = "FPS: " & Format(Round(Freq / (cTimer2 - cTimer), 1), "0.0") 'display fps on screen
        QueryPerformanceCounter cTimer 'get current time
        
        'Game code goes here.
    End If
    DoEvents
Wend

That's it!
To start the loop set Running to True and call the loop sub.
To end it, set Running to False.

Here's a finished example:

VB Code:

Option Explicit
 
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
 
Dim Running As Boolean                                                                  'To know if the game is running
Const FPS As Double = 61.3                                                              'Frames Per Second
 
Private Sub Form_Load()
    Me.Show                                                                             'Display main window
    Running = True
    GameLoop                                                                            'Start the loop
End Sub
 
Private Sub GameLoop()
    Dim cTimer As Currency                                                              'Time of last tick
    Dim cTimer2 As Currency                                                             'Current time
    Dim Freq As Currency                                                                'Frequency of Counter
    Dim Interval As Double                                                              'Time of each frame
    
    QueryPerformanceFrequency Freq                                                      'Get Frequency
    Interval = Freq / FPS                                                               'Calculate interval based on FPS and Frequency
    
    While Running                                                                       'Start loop
        QueryPerformanceCounter cTimer2                                                 'Get current time
        If cTimer2 >= cTimer + Interval Then                                            'Check if it's time to run code
            Me.Caption = "FPS: " & Format(Round(Freq / (cTimer2 - cTimer), 1), "0.0")   'Display FPS on screen
            QueryPerformanceCounter cTimer                                              'Get time for later use
            
            'Enter code here
        End If
        DoEvents
    Wend                                                                                'End loop
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    Running = False                                                                     'Exit loop
End Sub