Option Explicit

Public Const PI As Double = 3.14159265359

Public DX7 As New DirectX7
Public DD7 As DirectDraw7
Public PrimaryBuffer As DDSURFACEDESC2
Public Primary As DirectDrawSurface7
Public BackBuffer As DirectDrawSurface7
Public Caps As DDSCAPS2

Public CKeyB As DDCOLORKEY

Public ResolutionX As Integer
Public ResolutionY As Integer
Public ColorDepth As Byte

Public EmptyRect As RECT
Public EmptyStr As DDSURFACEDESC2

Public FPSTimer As Long
Public FPSCounter As Integer
Public FPS As Integer

Public Quit As Boolean
Public KeyUp As Boolean
Public KeyDown As Boolean
Public KeyLeft As Boolean
Public KeyRight As Boolean

Public Collision As Boolean

Public n As Integer
Public m As Integer

Type TShip
  Picture As DirectDrawSurface7
  Rectangle As RECT
  Str As DDSURFACEDESC2
  Width As Integer
  Height As Integer
  Pieces As Integer
  AnimationWidth As Integer
  SpeedX As Single
  SpeedY As Single
  Steer As Single
  SteerSpeed As Single
  RX As Single
  RY As Single
End Type
Public Ship As TShip

Type TPicture
  Picture As DirectDrawSurface7
  Rectangle As RECT
  Str As DDSURFACEDESC2
  Width As Integer
  Height As Integer
End Type
Public Sonne As TPicture
Public Erde As TPicture

Option Explicit

Private Sub Form_Load()
  ResolutionX = 1024
  ResolutionY = 768
  ColorDepth = 16

  CKeyB.low = 0
  CKeyB.high = 0

  With Ship
    .Width = 1920
    .Height = 48
    .Pieces = 40
    .AnimationWidth = .Width / .Pieces
    .SteerSpeed = 0.6
    .Steer = 0
    .SpeedX = 0
    .SpeedY = 0
    .RX = (ResolutionX - Ship.AnimationWidth) / 2
    .RY = (ResolutionY - Ship.Height) / 2
  End With

  With Sonne
    .Width = 768
    .Height = 768
  End With

  With Erde
    .Width = 95
    .Height = 96
  End With

  Initialization
  Loading

  Do
    PaintingGame
    DoEvents
  Loop Until Quit

  EndGame
End Sub

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

  Call DD7.SetCooperativeLevel(Me.hWnd, DDSCL_FULLSCREEN Or _
      DDSCL_ALLOWMODEX Or DDSCL_EXCLUSIVE)

  DD7.SetDisplayMode ResolutionX, ResolutionY, ColorDepth, 0, _
      DDSDM_DEFAULT

  PrimaryBuffer.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
  PrimaryBuffer.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or _
      DDSCAPS_FLIP Or DDSCAPS_COMPLEX
  PrimaryBuffer.lBackBufferCount = 1

  Set Primary = DD7.CreateSurface(PrimaryBuffer)

  Caps.lCaps = DDSCAPS_BACKBUFFER
  Set BackBuffer = Primary.GetAttachedSurface(Caps)

  Call BackBuffer.SetForeColor(RGB(255, 255, 255))
  Call BackBuffer.SetFontBackColor(0)
  Me.Show
End Sub

Sub Loading()
  With Ship
    .Str.lFlags = DDSD_CAPS
    .Str.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
    .Str.lWidth = .Width
    .Str.lHeight = .Height
    Set .Picture = DD7.CreateSurfaceFromFile(App.Path & _
        "\Ship.bmp", .Str)
    .Picture.SetColorKey DDCKEY_SRCBLT, CKeyB
    .Rectangle.Left = 0
    .Rectangle.Right = .AnimationWidth
    .Rectangle.Top = 0
    .Rectangle.Bottom = .Height
  End With

  With Sonne
    .Str.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
    .Str.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
    .Str.lWidth = .Width
    .Str.lHeight = .Height
    Set .Picture = DD7.CreateSurfaceFromFile(App.Path & _
        "\sonne.bmp", .Str)
    .Picture.SetColorKey DDCKEY_SRCBLT, CKeyB
  End With

  With Erde
    .Str.lFlags = DDSD_CAPS
    .Str.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
    .Str.lWidth = .Width
    .Str.lHeight = .Height
    Set .Picture = DD7.CreateSurfaceFromFile(App.Path & _
        "\erde.bmp", .Str)
    .Picture.SetColorKey DDCKEY_SRCBLT, CKeyB
  End With
End Sub

Sub PaintingGame()
  CalcMotion
  CalcFPS

  Call BackBuffer.BltColorFill(EmptyRect, 0)

  Call BackBuffer.BltFast(128, 0, Sonne.Picture, _
      Sonne.Rectangle, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)

  Call BackBuffer.BltFast(Ship.RX, Ship.RY, Ship.Picture, _
      Ship.Rectangle, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)

  Call BackBuffer.BltFast(228, 350, Erde.Picture, _
      Erde.Rectangle, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)

  Call BackBuffer.BltFast(600, 100, Erde.Picture, _
      Erde.Rectangle, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)

  Call BackBuffer.BltFast(800, 650, Erde.Picture, _
      Erde.Rectangle, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)

  CalcCollision

  Call BackBuffer.DrawText(10, 10, _
      "Kollisionsabfrage mit Hilfe von GetLockedPixel", False)
  Call BackBuffer.DrawText(10, 30, _
      "Steuerung erfolgt mit den Pfeiltasten", False)

  Call BackBuffer.DrawText( _
        10, 60, "Ship.Steer: " & Ship.Steer, False)
  Call BackBuffer.DrawText( _
        10, 80, "Ship.SpeedX: " & Ship.SpeedX, False)
  Call BackBuffer.DrawText( _
        10, 100, "Ship.SpeedY: " & Ship.SpeedY, False)

  Call BackBuffer.DrawText(10, 200, "FPS: " & FPS, False)

  If Collision = True Then
    Call BackBuffer.SetFontTransparency(False)
    Call BackBuffer.DrawText(ResolutionX / 2 - 30, 100, _
        " Kollision!!! ", False)
    Call BackBuffer.SetFontTransparency(True)
  End If

  Primary.Flip Nothing, DDFLIP_WAIT
End Sub

Sub CalcCollision()
  BackBuffer.Lock EmptyRect, EmptyStr, DDLOCK_READONLY, 0
  Ship.Picture.Lock Ship.Rectangle, Ship.Str, DDLOCK_READONLY, 0

  Collision = False

  For n = 0 To Ship.Height - 1
    For m = 0 To Ship.AnimationWidth - 1
      If Ship.Picture.GetLockedPixel(Ship.Rectangle.Left + m, n) _
        And Not BackBuffer.GetLockedPixel( _
          Ship.RX + m, Ship.RY + n) _
            Then Collision = True
      If Collision = True Then Exit For
    Next
    If Collision = True Then Exit For
  Next

  Ship.Picture.Unlock Ship.Rectangle
  BackBuffer.Unlock EmptyRect
End Sub

Sub CalcMotion()
  With Ship
    If KeyLeft = True Then .Steer = .Steer - .SteerSpeed
    If KeyRight = True Then .Steer = .Steer + .SteerSpeed

    If .Steer < 0 Then .Steer = .Steer + .Pieces
    If .Steer >= .Pieces Then .Steer = .Steer - .Pieces

    .Rectangle.Left = .AnimationWidth * Int(.Steer)
    .Rectangle.Right = .Rectangle.Left + .AnimationWidth

    If KeyUp = True Then
        .SpeedX = Cos(Int(.Steer) / (2 * PI) - PI / 2) * 5
        .SpeedY = Sin(Int(.Steer) / (2 * PI) - PI / 2) * 5
    ElseIf KeyDown = True Then
        .SpeedX = Cos(Int(.Steer) / (2 * PI) - PI / 2) * -5
        .SpeedY = Sin(Int(.Steer) / (2 * PI) - PI / 2) * -5
    Else
        .SpeedX = 0
        .SpeedY = 0
    End If

    .RX = .RX + .SpeedX
    .RY = .RY + .SpeedY
  End With
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyUp Then KeyUp = True
  If KeyCode = vbKeyDown Then KeyDown = True
  If KeyCode = vbKeyLeft Then KeyLeft = True
  If KeyCode = vbKeyRight Then KeyRight = True
  If KeyCode = vbKeyEscape Then Quit = True
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyUp Then KeyUp = False
  If KeyCode = vbKeyDown Then KeyDown = False
  If KeyCode = vbKeyLeft Then KeyLeft = False
  If KeyCode = vbKeyRight Then KeyRight = False
End Sub

Sub EndGame()
  Call DD7.RestoreDisplayMode
  Call DD7.SetCooperativeLevel(Me.hWnd, DDSCL_NORMAL)
  End
End Sub

Public Sub CalcFPS()
  If FPSTimer + 1000 <= DX7.TickCount Then
    FPSTimer = DX7.TickCount
    FPS = FPSCounter
    FPSCounter = 0
  Else
    FPSCounter = FPSCounter + 1
  End If
End Sub