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:
  1. Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
  2. 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:
  1. Dim Running As Boolean
  2. 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:
  1. Dim cTimer As Currency
  2. Dim cTimer2 As Currency
  3. Dim Freq As Currency
  4. 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:
  1. QueryPerformanceFrequency Freq
  2. 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:
  1. While Running
  2.     QueryPerformanceCounter cTimer2 'get current time
  3.     If cTimer2 >= cTimer + Interval Then 'compare current time with previous time and see if enough time has passed
  4.         Me.Caption = "FPS: " & Format(Round(Freq / (cTimer2 - cTimer), 1), "0.0") 'display fps on screen
  5.         QueryPerformanceCounter cTimer 'get current time
  7.         'Game code goes here.
  8.     End If
  9.     DoEvents
  10. 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:
  1. Option Explicit
  3. Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
  4. Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
  6. Dim Running As Boolean                                                                  'To know if the game is running
  7. Const FPS As Double = 61.3                                                              'Frames Per Second
  9. Private Sub Form_Load()
  10.     Me.Show                                                                             'Display main window
  11.     Running = True
  12.     GameLoop                                                                            'Start the loop
  13. End Sub
  15. Private Sub GameLoop()
  16.     Dim cTimer As Currency                                                              'Time of last tick
  17.     Dim cTimer2 As Currency                                                             'Current time
  18.     Dim Freq As Currency                                                                'Frequency of Counter
  19.     Dim Interval As Double                                                              'Time of each frame
  21.     QueryPerformanceFrequency Freq                                                      'Get Frequency
  22.     Interval = Freq / FPS                                                               'Calculate interval based on FPS and Frequency
  24.     While Running                                                                       'Start loop
  25.         QueryPerformanceCounter cTimer2                                                 'Get current time
  26.         If cTimer2 >= cTimer + Interval Then                                            'Check if it's time to run code
  27.             Me.Caption = "FPS: " & Format(Round(Freq / (cTimer2 - cTimer), 1), "0.0")   'Display FPS on screen
  28.             QueryPerformanceCounter cTimer                                              'Get time for later use
  30.             'Enter code here
  31.         End If
  32.         DoEvents
  33.     Wend                                                                                'End loop
  34. End Sub
  36. Private Sub Form_Unload(Cancel As Integer)
  37.     Running = False                                                                     'Exit loop
  38. End Sub