Tipp 0144 3D in DirectDraw
Autor/Einsender:
Datum:
  Alexander Csadek
24.10.2001
Entwicklungsumgebung:
DirectX-Version:
  VB 6
DirectX 7
Sie werden sicher fragen, wie geht 3D in DirectDraw. Nun, um eine Szene in 3D darzustellen braucht man noch etwas - Tiefe. In 3D wird zu der Koordinate X und Y noch die Koordinate Z verwendet, um festzulegen, wie weit das Objekt vom Betrachter entfernt ist.
Zu diesem Beispiel finden Sie die entsprechende Beschreibung in der DirectX-Rubrik zu DirectDraw.
Code im Codebereich des Moduls
 
Option Explicit

Type strcHund
  X           As Single
  Y           As Single
  Status      As Single
  AniCount    As Single
  PauseCount  As Single
End Type

Public Hund As strcHund

Public Const HundStart As Single = -200
Public Const HundFrameBreite As Single = 32
Public Const HundAniPause As Single = 200

Public FrameTime As Long
 
Code im Codebereich der Form frmMain
 
Option Explicit
Dim DX7 As New DirectX7
Dim DD7 As DirectDraw7
Dim SurfaceDesc As DDSURFACEDESC2
Dim PrimarySurface As DirectDrawSurface7
Dim BackBuffer As DirectDrawSurface7
Dim ddPF As DDPIXELFORMAT
Dim bmpHintergrund As DirectDrawSurface7
Dim bmpHaus As DirectDrawSurface7
Dim bmpBaum As DirectDrawSurface7
Dim bmpHund As DirectDrawSurface7
Dim SrcColorKey As Integer

Dim running As Boolean

Private Sub Form_Load()
  Dim SrcRect As RECT
  Dim DestRect As RECT
  Dim BGrect As RECT

  Me.Show
  Me.Refresh

  Initialization
  BitmapLaden

  Hund.X = HundStart
  Hund.Y = 510
  SrcColorKey = 1
  running = True

  Do
    FrameTime = GetTime

    With SrcRect
      .Left = 0: .Right = 480
      .Top = 0: .Bottom = 320
    End With
    With BGrect
      .Left = 0: .Right = 800
      .Top = 0: .Bottom = 600
    End With
    BackBuffer.Blt BGrect, bmpHintergrund, SrcRect, DDBLT_WAIT

    With SrcRect
      .Left = 0: .Right = 233
      .Top = 0: .Bottom = 235
    End With
    BackBuffer.BltFast _
        567, 280, bmpHaus, SrcRect, DDBLTFAST_WAIT Or SrcColorKey

    With SrcRect
      .Left = 0: .Right = 218
      .Top = 0: .Bottom = 196
    End With
    BackBuffer.BltFast _
        200, 330, bmpBaum, SrcRect, DDBLTFAST_WAIT Or SrcColorKey
    BackBuffer.BltFast _
        420, 330, bmpBaum, SrcRect, DDBLTFAST_WAIT Or SrcColorKey

    With SrcRect
      .Left = Int(Hund.AniCount) * HundFrameBreite
      .Right = .Left + HundFrameBreite
      .Top = 0: .Bottom = 32
    End With
    Select Case Hund.Status
      Case 0:
        DisplaySprite DestRect, bmpHund, SrcRect, Hund.X, Hund.Y
        Hund.X = Hund.X + 2
        Hund.AniCount = Hund.AniCount + 0.2
        If Hund.AniCount >= 4 Then
          If Hund.X > 350 Then
            Hund.Status = 1
            Hund.AniCount = 4
            Hund.PauseCount = 0
          Else
            Hund.AniCount = 0
          End If
        End If
      Case 1:
        DisplaySprite DestRect, bmpHund, SrcRect, Hund.X, Hund.Y
        Hund.AniCount = Hund.AniCount + 0.2
        If Hund.AniCount >= 6 Then Hund.AniCount = 4
        Hund.PauseCount = Hund.PauseCount + 1
        If Hund.PauseCount > HundAniPause Then
          Hund.Status = 2
          Hund.AniCount = 6
          Hund.PauseCount = 0
        End If
      Case 2:
        DisplaySprite DestRect, bmpHund, SrcRect, Hund.X, Hund.Y
        Hund.PauseCount = Hund.PauseCount + 1
        If Hund.PauseCount > HundAniPause Then
          Hund.Status = 3
          Hund.AniCount = 6
          Hund.PauseCount = 0
        End If
      Case 3:
        DisplaySprite DestRect, bmpHund, SrcRect, Hund.X, Hund.Y
        Hund.AniCount = Hund.AniCount + 0.2
        If Hund.AniCount >= 6 Then Hund.AniCount = 4
        Hund.PauseCount = Hund.PauseCount + 1
        If Hund.PauseCount > HundAniPause Then
          Hund.Status = 4
          Hund.AniCount = 0
          Hund.PauseCount = 0
        End If
      Case 4:
        DisplaySprite DestRect, bmpHund, SrcRect, Hund.X, Hund.Y
        Hund.X = Hund.X + 2
        Hund.AniCount = Hund.AniCount + 0.2
        If Hund.AniCount >= 4 Then
          If Hund.X > 832 Then
            Hund.Status = 5
            Hund.AniCount = 0
            Hund.PauseCount = 0
          Else
            Hund.AniCount = 0
          End If
        End If
      Case 5:
        Hund.PauseCount = Hund.PauseCount + 1
        If Hund.PauseCount > (HundAniPause * 3) Then
          Hund.Status = 0
          Hund.PauseCount = 0
          Hund.X = HundStart
        End If
    End Select

    With SrcRect
      .Left = 0: .Right = 218
      .Top = 0: .Bottom = 196
    End With
    BackBuffer.BltFast _
        55, 360, bmpBaum, SrcRect, DDBLTFAST_WAIT Or SrcColorKey

    BackBuffer.SetForeColor vbRed
    BackBuffer.SetFont Me.Font
    BackBuffer.DrawText _
        10, 10, "DirectDraw und transparente Farben", False
    BackBuffer.DrawText _
        10, 30, "<Esc> beendet das Programm", False
    If SrcColorKey = 0 Then
      BackBuffer.DrawText _
          10, 50, "<Space> ColorKey: DDBLTFAST_NOCOLORKEY", False
    Else
      BackBuffer.DrawText _
          10, 50, "<Space> ColorKey: DDBLTFAST_SRCCOLORKEY", False
    End If

    PrimarySurface.Flip Nothing, DDFLIP_WAIT
    ClearBuffer vbBlack

    Do Until GetTime - FrameTime > 18
    Loop

    DoEvents
  Loop While running

  Terminate

End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
  If (KeyAscii = vbKeyEscape) Then
    running = False
  End If
  If (KeyAscii = vbKeySpace) Then
    If SrcColorKey = 0 Then
      SrcColorKey = 1
    Else
      SrcColorKey = 0
    End If
  End If
End Sub

Sub Initialization()
  Set DD7 = DX7.DirectDrawCreate("")

  DD7.SetCooperativeLevel Me.hWnd, DDSCL_EXCLUSIVE Or _
        DDSCL_FULLSCREEN Or DDSCL_ALLOWREBOOT

  DD7.SetDisplayMode 800, 600, 16, 0, DDSDM_DEFAULT

  With SurfaceDesc
    .lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
    .ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or _
          DDSCAPS_FLIP Or DDSCAPS_COMPLEX
    .lBackBufferCount = 1
  End With
  Set PrimarySurface = DD7.CreateSurface(SurfaceDesc)
 
  SurfaceDesc.ddsCaps.lCaps = DDSCAPS_BACKBUFFER
  Set BackBuffer = _
        PrimarySurface.GetAttachedSurface(SurfaceDesc.ddsCaps)

  PrimarySurface.GetPixelFormat ddPF
End Sub

Sub BitmapLaden()
  Dim BmpDesc As DDSURFACEDESC2
  Dim ColorKey As DDCOLORKEY

  BmpDesc.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
  BmpDesc.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN

  BmpDesc.lWidth = 480
  BmpDesc.lHeight = 320
  Set bmpHintergrund = DD7.CreateSurfaceFromFile _
        (App.Path & "\Hintergrund.bmp", BmpDesc)

  BmpDesc.lWidth = 233
  BmpDesc.lHeight = 235
  Set bmpHaus = DD7.CreateSurfaceFromFile _
        (App.Path & "\Haus.bmp", BmpDesc)
  ColorKey.high = (ddPF.lRBitMask + ddPF.lBBitMask)
  ColorKey.low = (ddPF.lRBitMask + ddPF.lBBitMask)
  bmpHaus.SetColorKey DDCKEY_SRCBLT, ColorKey

  BmpDesc.lWidth = 218
  BmpDesc.lHeight = 196
  Set bmpBaum = DD7.CreateSurfaceFromFile _
        (App.Path & "\Baum.bmp", BmpDesc)
  ColorKey.high = _
        (ddPF.lRBitMask + ddPF.lGBitMask + ddPF.lBBitMask)
  ColorKey.low = _
        (ddPF.lRBitMask + ddPF.lGBitMask + ddPF.lBBitMask)
  bmpBaum.SetColorKey DDCKEY_SRCBLT, ColorKey

  BmpDesc.lWidth = 256
  BmpDesc.lHeight = 32
  Set bmpHund = DD7.CreateSurfaceFromFile _
        (App.Path & "\Hund.bmp", BmpDesc)
  ColorKey.high = ddPF.lGBitMask
  ColorKey.low = ddPF.lGBitMask
  bmpHund.SetColorKey DDCKEY_SRCBLT, ColorKey
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

Function GetTime() As Long
  GetTime = DX7.TickCount
End Function

Sub DisplaySprite(DestRect As RECT, Sprite As _
      DirectDrawSurface7, SrcRect As RECT, _
      Optional ByVal xCoord As Long, _
      Optional ByVal yCoord As Long)
  Dim XSrcRect As RECT

  XSrcRect = SrcRect
  With SrcRect
    If xCoord > (800 - (.Right - .Left)) Then _
        .Right = (.Right - (xCoord - (800 - (.Right - .Left))))
    If xCoord < 0 Then
      .Left = .Left + (xCoord * -1)
      xCoord = 0
    End If
    If yCoord > (600 - (.Bottom - .Top)) Then _
        .Bottom = (.Bottom - (yCoord - (600 - (.Bottom - .Top))))
    If yCoord < 0 Then
      .Top = .Top + (yCoord * -1)
      yCoord = 0
    End If
  End With
  BackBuffer.BltFast xCoord, yCoord, Sprite, SrcRect, _
        SrcColorKey Or DDBLTFAST_WAIT
  SrcRect = XSrcRect
End Sub

Sub Terminate()
  Set bmpHintergrund = Nothing
  Set bmpHaus = Nothing
  Set bmpBaum = Nothing
  Set bmpHund = Nothing

  DD7.RestoreDisplayMode
  DD7.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL
  Set PrimarySurface = Nothing
  Set DD7 = Nothing
  Set DX7 = Nothing
  End
End Sub
 
Weitere Links zum Thema
3D Grafiken erstellen (Rendern)
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  (353 kB) Downloads bisher: [ 2724 ]

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: Donnerstag, 8. September 2011