![]() |
Tipp 0110
|
DirectDraw im Fenster (Windowed-Mode)
|
 |
|
Autor/Einsender: Datum: |
|
Alexander Csadek 14.08.2001 |
|
Entwicklungsumgebung:
DirectX-Version: |
|
VB 6
DirectX 7 |
|
|
Dass DirectX-Anwendungen nicht nur
im Vollbild-Modus laufen müssen, zeigt dieser Tipp, zu dem eine ausführliche Beschreibung in unserer DirectX-Rubrik zu
DirectDraw.
verfügbar ist.
|
|
|
Option Explicit
Dim DX7 As New DirectX7
Dim DD7 As DirectDraw7
Dim SurfaceDesc As DDSURFACEDESC2
Dim PrimarySurface As DirectDrawSurface7
Dim BackBuffer As DirectDrawSurface7
Dim ddClipper As DirectDrawClipper
Dim r1 As RECT
Dim r2 As RECT
Dim running As Boolean
Dim FPSCounter As Single
Dim FPS As Single
Dim FPSTickLast As Long
Private Sub Form_Load()
Me.Show
Me.Refresh
Initialization
running = True
Do
DX7.GetWindowRect Me.hWnd, r1
BackBuffer.BltColorFill r2, 0
BackBuffer.SetForeColor vbRed
BackBuffer.SetFont Me.Font
BackBuffer.DrawText 1, 20, "FPS: " & Format(FPS, "0.0"), False
With r2
.Left = 0: .Right = 100
.Top = 0: .Bottom = 100
End With
PrimarySurface.Blt r1, BackBuffer, r2, DDBLT_WAIT
If FPSCounter = 30 Then
If (GetTime - FPSTickLast) > 0 Then _
FPS = 1000 * 30 / (GetTime - FPSTickLast)
FPSTickLast = GetTime
FPSCounter = 0
End If
FPSCounter = FPSCounter + 1
DoEvents
Loop While running
Terminate
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If (KeyAscii = vbKeyEscape) Then running = False
End Sub
Sub Initialization()
Set DD7 = DX7.DirectDrawCreate("")
DD7.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL
With SurfaceDesc
.lFlags = DDSD_CAPS
.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
End With
Set PrimarySurface = DD7.CreateSurface(SurfaceDesc)
With SurfaceDesc
.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
.lHeight = 100
.lWidth = 100
End With
Set BackBuffer = DD7.CreateSurface(SurfaceDesc)
Set ddClipper = DD7.CreateClipper(0)
ddClipper.SetHWnd Me.hWnd
PrimarySurface.SetClipper ddClipper
End Sub
Sub Terminate()
Set ddClipper = Nothing
Set BackBuffer = Nothing
Set PrimarySurface = Nothing
DD7.RestoreDisplayMode
DD7.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL
End
End Sub
Function GetTime() As Long
GetTime = DX7.TickCount
End Function
Private Sub Form_QueryUnload(Cancel As Integer, _
UnloadMode As Integer)
Terminate
End Sub
|
|
|
|
|
|
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/SE |
 |
|
ME |
 |
|
NT |
 |
|
2000 |
 |
|
XP |
 |
|
Vista |
 |
|
Win
7 |
 |
|
|
VB-Version |
VBA 5 |
 |
|
VBA 6 |
 |
|
VB 4/16 |
 |
|
VB 4/32 |
 |
|
VB 5 |
 |
|
VB 6 |
 |
|
|
|
Download (2,7
kB)
|
Downloads bisher: [ 1194 ]
|
|
|