Code:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' An alternative "timer" loop by Peter Scheutz Feb. 2001. '
' ' '
' Gives good timing, even with timeGetTime. '
' Goes below the limits of the normal SetTimer() timer. '
' No buildup of events, if your processing takes too long. '
' Uses PerformanceCounter if present, otherwise uses timeGetTime(). '
' Simple to use, and no hanging timer thread if you app crashes. '
'
' Released as Public domain. '
' '
' '
' Inspired by MSDN: '
' Moving Your Game to Windows, Part I: Tools, Game Loop, '
' Keyboard Input, And Timing '
' '
' Peter Donnelly '
' Microsoft Developer Network Technology Group '
' September 26, 1996 '
' '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
$Compile Exe
Option Explicit
$Include "WIN32API.INC"
' This Union is for converting a LARGE_INTEGER to a Quad
' I hope I'm doing that right. You might want to check...
Union QuadThing
Whole As Quad
Part As LARGE_INTEGER
End Union
Global mainExit As Long
Sub MyTimerProc(ByVal hWnd As Long, framesPerSec As Double)
SetWindowText hWnd,"Frames per sec: " & Format$(framesPerSec, "###.##")
' you can provoke a paint event here by using Invalidaterect()
End Sub
Function WinMain( ByVal hInstance As Long, _
ByVal hPrevInstance As Long, _
lpCmdLine As Asciiz Ptr, _
ByVal iCmdShow As Long ) As Long
Local Msg As tagMsg
Local wndclass As WndClassEx
Local szClassName As Asciiz * 80
Local hWnd As Long
Local nowtime As Quad
Local oldtime As Quad
Local quadFreq As QuadThing
Local quadNowTime As QuadThing
Local quadOldTime As QuadThing
Local TicksPerFrame As Quad
Local ticsPerSec As Quad
Local usePerformanceCounter As Long
szClassName = "MYCLASS"
wndclass.cbSize = SizeOf( WndClass )
wndclass.style = %CS_HREDRAW Or %CS_VREDRAW '
wndclass.lpfnWndProc = CodePtr( WndProc )
wndclass.cbClsExtra = 0
wndclass.cbWndExtra = 0
wndclass.hInstance = hInstance
wndclass.hIcon = LoadIcon( hInstance, "PROGRAM" )
wndclass.hCursor = LoadCursor( %NULL, ByVal %IDC_ARROW )
wndclass.hbrBackground = GetStockObject( %LTGRAY_BRUSH )
wndclass.lpszMenuName = %NULL
wndclass.lpszClassName = VarPtr( szClassName )
wndclass.hIconSm = %Null
RegisterClassEx wndclass
hWnd = CreateWindow( szClassName, _
"Timer loop", _
%WS_CAPTION Or %WS_SYSMENU, _
100, _
200, _
400, _
300, _
%HWND_DESKTOP, _
%NULL, _
hInstance, _
ByVal %NULL )
QueryPerformanceFrequency quadFreq.Part
'quadFreq.whole=0 ' UnREM to use timeGetTime
If quadFreq.whole<>0 Then 'is PerformanceCounter present?
usePerformanceCounter=%True
Else
quadFreq.whole=1000 ' for use with timeGetTime
' Msgbox "PerformanceCounter not present - using timeGetTime"
End If
%MS_PER_FRAME = 100' 33.33333333 ' 1 5 15 20 33 100 - try different values!
TicksPerFrame = (quadFreq.whole/1000)* %MS_PER_FRAME
mainExit = %FALSE
ShowWindow hWnd, %SW_SHOW
UpdateWindow hWnd
' This could be divided into two separate loops for efficiency
' If you only want to use timeGetTime, Longs could be used instead.
Do Until mainExit = %TRUE
If PeekMessage( Msg, %NULL, 0, 0, %PM_NOREMOVE ) Then
If getMessage( Msg, %NULL, 0, 0 ) = %FALSE Then
mainExit = %TRUE
Else
TranslateMessage Msg
DispatchMessage Msg
End If
End If
If usePerformanceCounter=%True Then
QueryPerformanceCounter quadNowTime.part
nowtime=quadNowTime.whole
Else
nowtime = timeGetTime()
End If
If nowtime > = oldtime + TicksPerFrame Then
If mainExit = %FALSE Then
myTimerProc hWnd , quadFreq.whole/(nowtime-oldtime)
End If
oldtime = nowtime
End If
Loop
Function = Msg.wParam
End Function
Function WndProc( ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long ) Export As Long
Local ps As PAINTSTRUCT
Local hDC As Long
Select Case wMsg
Case %WM_SYSCOMMAND
If wParam = %SC_CLOSE Then
mainExit = %TRUE
End If
Case %WM_PAINT
If mainExit = %False Then
hDC = BeginPaint( hWnd, ps )
' do painting here
EndPaint hWnd, ps
End If
Case %WM_CLOSE
mainExit = %TRUE
Case %WM_DESTROY
PostQuitMessage 0
Function = 0
Exit Function
End Select
Function = DefWindowProc( hWnd, wMsg, wParam, lParam )
End Function
[This message has been edited by Peter Scheutz (edited February 03, 2001).]