home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / DaBooda_2D1733984162004.psc / DaBooda2DEngineClass / Class / DaBoodaFrameRateCalculator.cls < prev    next >
Text File  |  2004-04-15  |  2KB  |  56 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "DaBoodaFRC"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = False
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
  11. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  12. Option Explicit
  13.  
  14. 'variables for Timing Loop
  15.     Private Frames As Single     'Frame Count
  16.     Private FPS As Single        'Actual FPS
  17.     Private FrameDelay As Single 'Frame Delay to set drawing to 60 FPS
  18.     Private LastFrame As Single  'Last Frame Count to keep time concurrent
  19.     Private Delay As Single      'This is to initiate the delay
  20.     Private Delay2 As Single     'This is another delay
  21.     Private FrameRate As Single  'This is Framerate to achieve
  22.     Private Declare Function GetTickCount Lib "kernel32" () As Long 'Get TickCount
  23.  
  24. Public Sub SetFrameRate(Value As Single)
  25.     FrameRate = Value
  26. End Sub
  27.  
  28. Public Function GetFPS() As Single
  29.     GetFPS = FPS
  30. End Function
  31.  
  32. Public Sub UpdateFPS()
  33. 'Do timer and check delay
  34.     For Delay = 0 To FrameDelay
  35.         For Delay2 = 0 To 2000: Next Delay2
  36.     Next Delay
  37.  
  38.     Frames = Frames + 1
  39.     If Frames = 30 Then
  40.         FPS = 1000 * 30 / (GetTime - LastFrame) + 1
  41.         Frames = 0
  42.         LastFrame = GetTime
  43.         'check delay and alter
  44.         If FPS > FrameRate Then FrameDelay = FrameDelay + 1
  45.         If FPS < FrameRate Then FrameDelay = FrameDelay - 1
  46.         If FrameDelay < 0 Then FrameDelay = 0
  47.     End If
  48.  
  49. End Sub
  50.  
  51. Private Function GetTime() As Single
  52. 'This Function is just a simple Timer, you call on it to get the current tick count
  53. GetTime = GetTickCount()
  54. End Function
  55.  
  56.