Tipp 0182 Parallaxe-Tiefeneindruck bewegter Objekte
Autor/Einsender:
Datum:
  Alexander Csadek
31.12.2001
Entwicklungsumgebung:
DirectX-Version:
  VB 6
DirectX 7
Wenn man sich bewegt ist es eigentlich so, dass sich ein Baum im Vordergrund deutlich schneller und weiter bewegt. als z.B. ein Haus im Hintergrund. Dieser Effekt wird als Parallaxe bezeichnet und ist der Schlüssel zu unserer Wahrnehmung von Tiefe.
Zu diesem Tipp finden Sie eine ausführliche Beschreibung in unserer DirectX-Rubrik zu DirectDraw unter Parallaxe - Tiefeneindruck bewegter Objekte.
Der abgebildete Code bezieht sich auf nur auf die eigentliche Parallaxe. Da der Code für die Initialisierung von DirectX meist immer gleich bleibt, wird dieser hier nicht gesondert abgebildet. Das Download-Beispiel ist jedoch der gesamte Code
Code im Codebereich des Moduls
 
Option Explicit

Public Const NUM_LAYERS As Single = 3

Type strcLAYER
  surf        As DirectDrawSurface7
  blit_flags  As Long
  start_x     As Long
  start_y     As Long
  interval    As Long
  parallax    As Double
  lwidth      As Long
  lheight     As Long
End Type

Public Layers(3) As strcLAYER
Public Taxi_Width As Long
Public Taxi_Height As Long
Public taxi_pos As Long
 
Code im Codebereich der Form
 
Option Explicit

Dim DX7 As New DirectX7
Dim DD7 As DirectDraw7
Dim SurfaceDesc As DDSURFACEDESC2
Dim PrimarySurface As DirectDrawSurface7
Dim BackBuffer As DirectDrawSurface7
Dim ddpfPS As DDPIXELFORMAT
Dim bmpInterface As DirectDrawSurface7
Dim bmpBack1 As DirectDrawSurface7
Dim bmpBack2 As DirectDrawSurface7
Dim bmpGround As DirectDrawSurface7
Dim bmpLight As DirectDrawSurface7
Dim bmpTaxi As DirectDrawSurface7

Const min_pos As Long = 0
Const max_pos As Long = 50000

Dim x_pos As Long
Dim move_rate As Integer
Dim running As Boolean

Private Sub Form_Load()
  Dim srcrect As RECT
  Dim i As Single
  Dim screen_pos As Long
  Dim screen_x As Long
  Dim obj_pos As Long

  Me.Show
  Me.Refresh

  Initialization
  BitmapLaden

  x_pos = 25000
  move_rate = 0
  taxi_pos = 30000

  running = True

  Do
    x_pos = x_pos + move_rate
    If x_pos < min_pos Then
      x_pos = min_pos
      move_rate = 0
    End If
    If x_pos > max_pos Then
      x_pos = max_pos
      move_rate = 0
    End If

    For i = 0 To NUM_LAYERS
      screen_pos = x_pos * Layers(i).parallax
      obj_pos = Layers(i).start_x

      Do While (obj_pos < (screen_pos + 640))

        If (obj_pos + Layers(i).lwidth) >= screen_pos Then
          screen_x = obj_pos - screen_pos

          srcrect.Left = 0
          srcrect.Top = 0
          srcrect.Right = Layers(i).lwidth
          srcrect.Bottom = Layers(i).lheight

          If screen_x < 0 Then
            srcrect.Left = srcrect.Left - screen_x
            screen_x = 0
          ElseIf (screen_x + srcrect.Right) > 640 Then
            srcrect.Right = 640 - screen_x
          End If

          BackBuffer.BltFast screen_x, Layers(i).start_y, _
                Layers(i).surf, srcrect, _
                Layers(i).blit_flags
        End If

        obj_pos = obj_pos + Layers(i).interval
      Loop
    Next i

    screen_pos = x_pos * 3

    If (taxi_pos + Taxi_Width) > screen_pos And _
      taxi_pos < (screen_pos + 640) Then
       screen_x = taxi_pos - screen_pos

       srcrect.Left = 0
       srcrect.Top = 0
       srcrect.Right = Taxi_Width
       srcrect.Bottom = Taxi_Height
       If screen_x < 0 Then
           srcrect.Left = srcrect.Left - screen_x
           screen_x = 0
       ElseIf (screen_x + srcrect.Right) > 640 Then
           srcrect.Right = 640 - screen_x
       End If

       BackBuffer.BltFast screen_x, 220, _
           bmpTaxi, srcrect, _
           DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
    End If

    taxi_pos = taxi_pos - 3.5
    If taxi_pos < (screen_pos - 5000) Then _
          taxi_pos = screen_pos + 5000

    With srcrect
      .Top = 0: .Left = 0: .Right = 640: .Bottom = 480
    End With

    BackBuffer.BltFast 0, 0, bmpInterface, _
        srcrect, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY

    BackBuffer.SetForeColor vbRed
    BackBuffer.SetFont Me.Font
    BackBuffer.DrawText _
          10, 390, "DirectDraw und PARALLAXE", False
    BackBuffer.DrawText _
          10, 410, "<Esc> beendet das Programm", False
    BackBuffer.DrawText _
          10, 430, "CursorTaste für Links/Rechts-Scrollen", False
    BackBuffer.DrawText 10, 450, _
          "(nochmaliges drücken für schnelleres Scrollen)", False

    PrimarySurface.Flip Nothing, DDFLIP_WAIT

    ClearBuffer vbBlack

    DoEvents
  Loop While running

  Terminate
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
  If (KeyAscii = vbKeyEscape) Then
    running = False
  End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyLeft Then
    If move_rate > -10 Then
      move_rate = move_rate - 2
    End If
  End If

  If KeyCode = vbKeyRight Then
    If move_rate < 10 Then
      move_rate = move_rate + 2
    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 640, 480, 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 ddpfPS
End Sub

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

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

  CK.high = ddpfPS.lGBitMask
  CK.low = ddpfPS.lGBitMask

  BmpDesc.lwidth = 640
  BmpDesc.lheight = 480
  Set bmpInterface = DD7.CreateSurfaceFromFile _
        (App.Path & "\ntrface.bmp", BmpDesc)

  bmpInterface.SetColorKey DDCKEY_SRCBLT, CK

  BmpDesc.lwidth = 520
  BmpDesc.lheight = 172
  Set bmpBack1 = DD7.CreateSurfaceFromFile _
        (App.Path & "\back.bmp", BmpDesc)

  Set Layers(0).surf = bmpBack1
  Layers(0).blit_flags = DDBLTFAST_WAIT
  Layers(0).start_x = 0
  Layers(0).start_y = 0
  Layers(0).parallax = 0.8
  Layers(0).interval = 520
  Layers(0).lwidth = 520
  Layers(0).lheight = 172

  BmpDesc.lwidth = 620
  BmpDesc.lheight = 189
  Set bmpBack2 = DD7.CreateSurfaceFromFile _
        (App.Path & "\back2.bmp", BmpDesc)

  bmpBack2.SetColorKey DDCKEY_SRCBLT, CK

  Set Layers(1).surf = bmpBack2
  Layers(1).blit_flags = DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
  Layers(1).start_x = 0
  Layers(1).start_y = 45
  Layers(1).parallax = 1.4
  Layers(1).interval = 620
  Layers(1).lwidth = 620
  Layers(1).lheight = 189

  BmpDesc.lwidth = 64
  BmpDesc.lheight = 265
  Set bmpLight = DD7.CreateSurfaceFromFile _
        (App.Path & "\light.bmp", BmpDesc)

  bmpLight.SetColorKey DDCKEY_SRCBLT, CK

  Set Layers(2).surf = bmpLight
  Layers(2).blit_flags = DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
  Layers(2).start_x = 0
  Layers(2).start_y = 8
  Layers(2).parallax = 1.8
  Layers(2).interval = 600
  Layers(2).lwidth = 64
  Layers(2).lheight = 265

  BmpDesc.lwidth = 328
  BmpDesc.lheight = 280
  Set bmpGround = DD7.CreateSurfaceFromFile _
        (App.Path & "\ground.bmp", BmpDesc)

  Set Layers(3).surf = bmpGround
  Layers(3).blit_flags = DDBLTFAST_WAIT
  Layers(3).start_x = 0
  Layers(3).start_y = 106
  Layers(3).parallax = 2.4
  Layers(3).interval = 328
  Layers(3).lwidth = 328
  Layers(3).lheight = 280

  BmpDesc.lwidth = 396
  BmpDesc.lheight = 150
  Set bmpTaxi = DD7.CreateSurfaceFromFile _
        (App.Path & "\taxi.bmp", BmpDesc)

  bmpTaxi.SetColorKey DDCKEY_SRCBLT, CK

  Taxi_Width = 396
  Taxi_Height = 150
End Sub

Sub Terminate()
  Set bmpInterface = Nothing
  Set bmpBack1 = Nothing
  Set bmpBack2 = Nothing
  Set bmpGround = Nothing
  Set bmpLight = Nothing
  Set bmpTaxi = Nothing

  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 = 480
    .Left = 0
    .Right = 640
    .Top = 0
  End With
  BackBuffer.BltColorFill destrect, Color
End Sub

Function GetTime() As Long
  GetTime = DX7.TickCount
End Function
 
Weitere Links zum Thema
Hintergrund-Scrolling
Transparente Farben
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  (453 kB) Downloads bisher: [ 2609 ]

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: Samstag, 24. September 2011