|
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
|
|