Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0452: FPS - Frames pro Sekunde ermitteln

VB 5/6-Tipp 0452: FPS - Frames pro Sekunde ermitteln

 von Benjamin Wilger

Schwierigkeitsgrad:

Verwendete API-Aufrufe: StretchBlt

Download: Download des Beispielprojektes [12,97 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Optionsfeld-Steuerelement "Option1" (Index von 0 bis 1)
' Steuerelement: Horizontale Scrollbar "HScroll1"
' Steuerelement: Timersteuerelement "tmrAnimation"
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Bildfeld-Steuerelement "Picture2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Timersteuerelement "tmrFPS"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"
' Steuerelement: Beschriftungsfeld "lblFPS"
' Code von Benjamin Wilger
' Benjamin@ActiveVB.de
' Copyright (C) 2001
Option Explicit

Private Declare Function StretchBlt Lib "gdi32" ( _
                         ByVal hdc As Long, _
                         ByVal x As Long, _
                         ByVal y As Long, _
                         ByVal nWidth As Long, _
                         ByVal nHeight As Long, _
                         ByVal hSrcDC As Long, _
                         ByVal xSrc As Long, _
                         ByVal ySrc As Long, _
                         ByVal nSrcWidth As Long, _
                         ByVal nSrcHeight As Long, _
                         ByVal dwRop As Long) As Long
                         
Private FCount As Long ' Anzahl der Frames
Private FPS As Double

Private Sub Form_Load()

    Picture1.Picture = LoadPicture(App.Path & "\billborg.jpg")
    
End Sub

Private Sub tmrFPS_Timer()

    FPS = FCount / (tmrFPS.Interval / 1000) ' Die Frames auf das
                                            ' Timer-Intervall 1000
                                            ' umrechnen
    FCount = 0 ' Anzahl der Frames auf Null zurückstellen um eine neue
               ' Messung zu starten
    lblFPS.Caption = "FPS: " & Round(FPS, 2) ' Ausgeben
    
End Sub

Private Sub HScroll1_Change()

    tmrFPS.Interval = 1000 / HScroll1.Value
    
End Sub

Private Sub Command1_Click()

    tmrAnimation.Enabled = Not tmrAnimation.Enabled ' Timer schalten(ON/OFF)
    
End Sub

Private Sub tmrAnimation_Timer()

    Static Position As Long
    Static theta As Double, adder1 As Long, adder2 As Long
    
    Dim Pi As Double
    
    Pi = Atn(1) * 4
    theta = theta + Pi / 16
    
    If theta > 2 * Pi Then theta = 0
    
    ' Hier wird zum Testen der FPS eine einfache Animation gemacht
    Position = Position + 5
    
    If Position > Picture2.ScaleWidth Then
    
        Position = -Picture1.ScaleWidth
        
    End If
    
    adder1 = 25 * Sin(theta)
    adder2 = 25 * Cos(theta)
    Picture2.Cls
    
    If Option1(0).Value Then
    
        Picture2.PaintPicture Picture1.Picture, Position + adder1, ( _
            Picture2.ScaleHeight - Picture1.ScaleHeight) / 2 + adder1, _
            Picture1.ScaleWidth + adder2, Picture1.ScaleHeight + adder2
            
    Else
    
        StretchBlt Picture2.hdc, Position + adder1, (Picture2.ScaleHeight - _
            Picture1.ScaleHeight) / 2 + adder1, Picture1.ScaleWidth + _
            adder2, Picture1.ScaleHeight + adder2, Picture1.hdc, 0, 0, _
            Picture1.ScaleWidth, Picture1.ScaleHeight, vbSrcCopy
            
    End If
    
    Picture2.Refresh
    FCount = FCount + 1 ' Hier den FrameCount erhöhen.
    
End Sub

'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 1 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.