VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cS2DFps"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private CFm_LastTimeCheckFPS      As Double
Private CFm_FramesDrawn           As Integer
Private CFm_FrameRate             As Integer
Private CFm_SmoothFps             As Integer

Public Property Get LastTimeCheckFPS() As Double

 
    LastTimeCheckFPS = CFm_LastTimeCheckFPS

End Property

Public Property Let LastTimeCheckFPS(ByVal PropVal As Double)

     CFm_LastTimeCheckFPS = PropVal

End Property

Public Property Get FramesDrawn() As Integer

   FramesDrawn = CFm_FramesDrawn

End Property

Public Property Let FramesDrawn(ByVal PropVal As Integer)
  
  CFm_FramesDrawn = PropVal

End Property

Public Property Get FrameRate() As Integer

    FrameRate = CFm_FrameRate

End Property

Public Property Let FrameRate(ByVal PropVal As Integer)

    CFm_FrameRate = PropVal

End Property

Public Property Get SmoothFps() As Integer

    SmoothFps = CFm_SmoothFps

End Property

Public Property Let SmoothFps(ByVal PropVal As Integer)

    CFm_SmoothFps = PropVal

End Property

Private Function RoundBy(ByVal intValue As Integer, _
                         Optional By As Integer = 1) As Integer


  Dim Counter As Long
  Dim Counter2 As Long
  
     Counter = intValue
    Counter2 = intValue
    Do
    DoEvents
        Counter = Counter + 1
        Counter2 = Counter2 - 1
        If Counter Mod By = 0 Then
            RoundBy = Counter
            Exit Function
        End If
        If Counter2 Mod By = 0 Then
            RoundBy = Counter2
            Exit Function
        End If
    Loop

End Function


Public Function CalcFps() As Integer
On Error Resume Next
If GetTickCount - CFm_LastTimeCheckFPS >= 1000 Then
CFm_LastTimeCheckFPS = GetTickCount
CFm_SmoothFps = CFm_FramesDrawn
CFm_FramesDrawn = 0
End If
CFm_FramesDrawn = CFm_FramesDrawn + 1
CFm_FrameRate = ((1000 / (GetTickCount - CFm_LastTimeCheckFPS)) * CFm_FramesDrawn)
On Error GoTo 0
End Function

