Hi Peter,
My frame rate is around 80 fps.
I also verified it with a hi res timer, (which is safer to use because it turns over in about 64 years instead of 40 days)
Snippet
'=====================
'HIGH PRECISION TIMING
'=====================
'http://msdn.microsoft.com/en-us/library/ms644904(v=vs.85).aspx
Declare Function QueryPerformanceCounter Lib "kernel32.dll" (ByRef lpPerformanceCount As quad) As Long
Declare Function QueryPerformanceFrequency Lib "kernel32.dll" (ByRef lpFrequency As quad) As Long
quad qc1,qc2,qf
QueryPerformanceFrequency qf
QueryPerformanceCounter qc1
'-------------
Function FPS()
'=============
QueryPerformanceCounter qc2
if qc2-qc1>qf then 'greater than 1 second lapsed
fjs=frames
frames=0
qc1+=qf 'add 1 second
end if
Frames+=1
End Function
Your first example with this timer:
IndexBase 0
Include Once "Win_C.inc"
Include Once "Win_D.inc"
Include Once "Win_G.inc"
Dim x,a,zs,frames,Fjs,bHdc,hFont as sys
Dim s as string
'=====================
'HIGH PRECISION TIMING
'=====================
'http://msdn.microsoft.com/en-us/library/ms644904(v=vs.85).aspx
Declare Function QueryPerformanceCounter Lib "kernel32.dll" (ByRef lpPerformanceCount As quad) As Long
Declare Function QueryPerformanceFrequency Lib "kernel32.dll" (ByRef lpFrequency As quad) As Long
quad qc1,qc2,qf
QueryPerformanceFrequency qf
QueryPerformanceCounter qc1
'-------------
Function FPS()
'=============
QueryPerformanceCounter qc2
if qc2-qc1>qf then 'greater than 1 second lapsed
fjs=frames
frames=0
qc1+=qf 'add 1 second
end if
Frames+=1
End Function
Function WndProc(byval hWnd as long,byval wMsg as long, byval wParam as long,byval lparam as long) as long callback
if wMsg = WM_CREATE
'
elseif wMsg = WM_PAINT
'
elseif wMsg = WM_MOUSEMOVE
xMouse = LoWord(lParam)
yMouse = HiWord(lParam)
'
elseif wMsg = WM_DESTROY
PostQuitMessage 0
else
Function = DefWindowProc hWnd,wMsg,wParam,lParam
endif
End Function
Declare Function SquareWave(byval Hdc as long, byval x as long, byval y as long, byval x1 as long, byval y1 as long)
SetWindow "FrameCounter",640,490,WS_DLGFRAME
bHdc = SetBuffer 640,490
hFont = CreateFont 16,12,0,0,FW_BOLD,0,0,0,0,0,0,0,0,"times"
SelectObject bHdc,hFont
SetBkMode bHdc,1
SetTextcolor bHdc,RGB(0,125,125)
While EscKey() =0
Rectangle bHdc,-1,-1,640,480
for a=1 to 13
Circle bHdc,45*a,200,45,155
Circle bHdc,45*a,245,45,155*256
Circle bHdc,45*a,290,45,155*65536
Next
Line bHdc,0,154,639,154,Rgb(55,55,0)
Line bHdc,0,336,639,336,Rgb(55,55,0)
for x= 0 to 19
SquareWave bhdc, 0+x*40,460,20+x*40,460
SquareWave bhdc,20+x*40,460,20+x*40,420
SquareWave bhdc,20+x*40,420,40+x*40,420
SquareWave bhdc,40+x*40,420,40+x*40,460
Next
FPS()
s = "FramesPerSec = " + str(Fjs)
TextOut bHdc,16,0,s,Len(s)
DoEvents
FlipBuffer
Wend
ExitProcess 0
Function SquareWave(byval Hdc as long, byval x as long, byval y as long, byval x1 as long, byval y1 as long)
Line Hdc,x,y,x1,y1,Rgb(128,0,0)
End Function
'-------------------------------
'5 MILLISECOND RESOLUTION TIMING
'--------------------------------
'http://msdn.microsoft.com/en-us/library/dd757629(v=vs.85).aspx
Function mFPS()
Frames = Frames +1
if zs + 1001 < timeGetTime
Fjs = Frames
Frames =0
zs = timeGetTime
endif
End Function
Charles