Tipp 0175 DirectDraw - Hintergrund-Scrolling
Autor/Einsender:
Datum:
  Alexander Csadek
13.12.2001
Entwicklungsumgebung:
DirectX-Version:
  VB 6
DirectX 7
Wer kennt es nicht aus Jump&Run- oder Adventure-Spielen, wo sich der Hintergrund ab einer bestimmten Position der Spielfigur mitbewegt, und so die eigentliche Spielfläche weitaus größer ist, als das sichtbare Fläche auf dem Monitor. Dieses Beispiel zeigt auf wie sich ein links/rechts scrollender Hintergrund mit einem Start- und Endpunkt realisieren lässt.
Zu diesem Tipp finden Sie eine ausführliche Beschreibung in unserer DirectX-Rubrik zu DirectDraw unter Hintergrund-Scrolling.
 
Option Explicit

Dim DX7 As New DirectX7
Dim DD7 As DirectDraw7
Dim SurfaceDesc As DDSURFACEDESC2
Dim PrimarySurface As DirectDrawSurface7
Dim BackBuffer As DirectDrawSurface7
Dim bmpBackground(2) As DirectDrawSurface7

Const min_pos As Long = 0
Const max_pos As Long = 3000

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

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

  Me.Show
  Me.Refresh

  Initialization
  BitmapLaden

  x_pos = 1400
  move_rate = 0

  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 2
      tile_pos = 400 * i + (x_pos \ 1200) * 1200
      If (tile_pos + 1200) < (x_pos + 640) Then _
            tile_pos = tile_pos + 1200

      If (tile_pos + 400) >= x_pos Then
        screen_x = tile_pos - x_pos

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

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

        BackBuffer.BltFast screen_x, 0, bmpBackground(i), _
              srcrect, DDBLTFAST_WAIT
      End If
    Next i

    BackBuffer.SetForeColor vbRed
    BackBuffer.SetFont Me.Font
    BackBuffer.DrawText _
          10, 10, "DirectDraw und Hintergrund-Scrolling ", False
    BackBuffer.DrawText _
          10, 30, "<Esc> beendet das Programm", False
    BackBuffer.DrawText _
          10, 50, "Cursortasten Links/Rechts für scrollen", False
    BackBuffer.DrawText 10, 70, "mehrfaches Betätigen der " & _
          "Cursortasten beschleunigt das 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 > -20 Then
      move_rate = move_rate - 5
    End If
  End If
  If KeyCode = vbKeyRight Then
    If move_rate < 20 Then
      move_rate = move_rate + 5
    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)
End Sub

Sub BitmapLaden()
  Dim BmpDesc As DDSURFACEDESC2

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

  BmpDesc.lWidth = 400
  BmpDesc.lHeight = 480

  Set bmpBackground(0) = _
      DD7.CreateSurfaceFromFile(App.Path & "\city1.bmp", BmpDesc)
  Set bmpBackground(1) = _
      DD7.CreateSurfaceFromFile(App.Path & "\city2.bmp", BmpDesc)
  Set bmpBackground(2) = _
      DD7.CreateSurfaceFromFile(App.Path & "\city3.bmp", BmpDesc)
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

Sub Terminate()
  Dim i As Single

  For i = 0 To 2
    Set bmpBackground(i) = Nothing
  Next i

  DD7.RestoreDisplayMode
  DD7.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL
  Set PrimarySurface = Nothing
  Set DD7 = Nothing
  Set DX7 = Nothing
  End
End Sub
 
Weitere Links zum Thema
Parallaxe - Tiefeneindruck bewegter Objekte
Transparente Farben
GIF- & JPG-Grafiken ohne OCX in DD-Surface laden
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  (575 kB) Downloads bisher: [ 2813 ]

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