Re: Controlling refresh rate
Take a look at my managed game loop. It locks the framerate at 60 frames per second or whatever you so choose:
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
Private Ticks_Per_Second As Currency
Private Start_Time As Currency
Private Milliseconds As Long
Private Last_Time As Long
Private Get_Frames_Per_Second As Long
Private Frame_Count As Long
Private Running As Boolean
Public Function Hi_Res_Timer_Initialize() As Boolean
If QueryPerformanceFrequency(Ticks_Per_Second) = 0 Then
Hi_Res_Timer_Initialize = False
Else
QueryPerformanceCounter Start_Time
Hi_Res_Timer_Initialize = True
End If
End Function
Public Function Get_Elapsed_Time() As Single
Dim Last_Time As Currency
Dim Current_Time As Currency
QueryPerformanceCounter Current_Time
Get_Elapsed_Time = (Current_Time - Last_Time) / Ticks_Per_Second
QueryPerformanceCounter Last_Time
End Function
Private Sub Lock_Framerate(Target_FPS As Long)
Static Last_Time As Currency
Dim Current_Time As Currency
Dim FPS As Single
Do
QueryPerformanceCounter Current_Time
FPS = Ticks_Per_Second / (Current_Time - Last_Time)
Loop While (FPS > Target_FPS)
QueryPerformanceCounter Last_Time
End Sub
Private Function Get_FPS() As String
Frame_Count = Frame_Count + 1
If Get_Elapsed_Time - Milliseconds >= 1 Then
Get_Frames_Per_Second = Frame_Count
Frame_Count = 0
Milliseconds = Get_Elapsed_Time
End If
Get_FPS = "FPS: " & Get_Frames_Per_Second
End Function
Private Sub Shutdown()
Running = False
Unload Me
End Sub
Private Sub Main()
With Me
.Show
.ScaleMode = 3
.AutoRedraw = True
.BackColor = RGB(0, 0, 0)
End With
Running = True
Hi_Res_Timer_Initialize
Milliseconds = Get_Elapsed_Time
Main_Loop
End Sub
Private Sub Main_Loop()
Do While Running = True
'//Timer Code Goes Here
Me.Caption = Get_FPS
DoEvents
Lock_Framerate 60
Loop
End Sub
Private Sub Form_Load()
Main
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
Shutdown
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Shutdown
End Sub
Also if you ever want to, take a look at my Massive DirectX Tutorial in my signature if you wanna make your games a little more professional. I also am currently redoing the entire tutorial by improving the ones I made by a lot and slapping on a couple hundred other tutorials as well in both 2D and 3D and DirectDraw in DirectX7 - DirectX11 in VB6, VB.Net 2008, VB.Net 2010, C# 2008, C# 2010, C++ 6.0, C++ 2008, and C++ 2010. I got a website going but its still under construction along with my tutorials. Its gonna cover every aspect of DirectX nearly and have advanced topics that are difficult to find on the net.