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
 
Weitere Links zum Thema
Animation in PictureBox
Rendern in einer PictureBox (Windowed Mode)
Hinweis
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: [ 1104 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Dienstag, 9. August 2011