|
Tipp 0542
|
Berechnen der Framerate
|
|
|
Autor/Einsender: Datum: |
|
Alexander Csadek 26.12.2008 |
|
Entwicklungsumgebung:
DirectX-Version: |
|
VB 6
DirectX 7 |
|
|
Die Bildwiederholrate von Bildern oder Bildszenen die maximal in bestimmten Auflösungen innerhalb einer Sekunde auf dem Monitor dargestellt werden können
nennt man Framerate. Sie wird in fps (Frames per Second) gemessen, und
je höher dieser Wert in einem Projekt ist, um so flüssiger ist der
Bewegungsablauf.
|
Dieser Tipp zeigt, wie die Berechnung der Framerate
in ein eigenes
Projekt integriert werden kann, um so auch die Spielbarkeit sicherzustellen,
um ggf. seinen Code besser zu optimieren.
|
|
|
Option Explicit
Dim DX7 As New DirectX7
Dim DD7 As DirectDraw7
Dim SurfaceDesc As DDSURFACEDESC2
Dim PrimarySurface As DirectDrawSurface7
Dim BackBuffer As DirectDrawSurface7
Dim running As Boolean
Dim FPS As Integer
Private Sub Form_KeyPress(KeyAscii As Integer)
If (KeyAscii = vbKeyEscape) Then
running = False
End If
End Sub
Private Sub Form_Load()
Me.Show
Me.Refresh
Initialization 'DirectDraw initialisieren
running = True
Do
'Frames per Second berechnen
CountFPS
BackBuffer.SetForeColor vbRed
BackBuffer.SetFont Me.Font
BackBuffer.DrawText 10, 10, _
"DirectDraw - Frame Rate berechnen", False
BackBuffer.DrawText 10, 30, "<Esc> beendet das Programm", False
BackBuffer.DrawText 10, 50, "FPS: " & Format(FPS, "0.0"), False
'Inhalt des BackBuffers in den PrimarySurface kopieren
PrimarySurface.Flip Nothing, DDFLIP_WAIT
'BackBuffer löschen
ClearBuffer vbBlack
DoEvents
Loop While running
Terminate
End Sub
Sub Initialization() 'DirectDraw wird initialisiert
Set DD7 = DX7.DirectDrawCreate("")
DD7.SetCooperativeLevel Me.hWnd, DDSCL_EXCLUSIVE Or _
DDSCL_FULLSCREEN Or DDSCL_ALLOWREBOOT
DD7.SetDisplayMode 800, 600, 16, 0, DDSDM_DEFAULT
'Beschreibung des PrimarySurface mit einem BackBuffer
With SurfaceDesc
.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or _
DDSCAPS_COMPLEX
.lBackBufferCount = 1
End With
'PrimarySurface initialisieren auf dem alles abgebildet wird
Set PrimarySurface = DD7.CreateSurface(SurfaceDesc)
SurfaceDesc.ddsCaps.lCaps = DDSCAPS_BACKBUFFER
Set BackBuffer = _
PrimarySurface.GetAttachedSurface(SurfaceDesc.ddsCaps)
End Sub
Sub Terminate()
'alte Auflösung wiederherstellen
DD7.RestoreDisplayMode
DD7.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL
Set PrimarySurface = Nothing
Set DD7 = Nothing
Set DX7 = Nothing
End
End Sub
Sub ClearBuffer(Color As Long)
Dim DestRect As RECT
With DestRect
.Bottom = 600
.Left = 0
.Right = 800
.Top = 0
End With
BackBuffer.BltColorFill DestRect, Color
End Sub
Public Sub CountFPS()
Static LastTime As Long
Static counter As Integer
Static savedTick As Long
counter = counter + 1
If DX7.TickCount - LastTime >= 1000 Then
LastTime = DX7.TickCount
FPS = counter
counter = 0
End If
While DX7.TickCount - savedTick < 1000 \ 60
DoEvents
Wend
savedTick = DX7.TickCount
End Sub
|
|
|
|
Der Code ist im Projekt entsprechend ausführlich kommentiert.
|
Um dieses Beispiel ausführen zu können, wird die DirectX 7
for Visual Basic Type Library
benötigt (siehe dazu die Erläuterungen in der DirectX-Rubrik).
|
|
Windows-Version |
95 |
|
|
98 |
|
|
ME |
|
|
NT |
|
|
2000 |
|
|
XP |
|
|
Vista |
|
|
Win
7 |
|
|
|
VB-Version |
VBA 5 |
|
|
VBA 6 |
|
|
VB 4/16 |
|
|
VB 4/32 |
|
|
VB 5 |
|
|
VB 6 |
|
|
|
|
Download (3
kB)
|
Downloads bisher: [ 126 ]
|
|
|