Option Explicit

Public Const PI As Double = 3.14159265359
Public Const MaxBackStars As Integer = 300

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 ResolutionX As Integer
Public ResolutionY As Integer
Public ColorDepth As Byte

Public EmptyRect As RECT
Public EmptyStr As DDSURFACEDESC2

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

Public ShipSpeedX As Single
Public ShipSpeedY As Single
Public ShipSteer As Single

Public n As Integer
Public m As Integer

Type TStars
  RX(2, MaxBackStars) As Single
  RY(2, MaxBackStars) As Single
  Color(2) As Long
End Type

Public BackStars As TStars

Option Explicit

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

  With BackStars
    For n = 0 To MaxBackStars
      For m = 0 To 2
        .RX(m, n) = Rnd * ResolutionX
        .RY(m, n) = Rnd * ResolutionY
      Next
    Next
    .Color(0) = RGB(255, 255, 255)
    .Color(1) = RGB(200, 200, 200)
    .Color(2) = RGB(150, 150, 150)
  End With

  Initialization

  Do
    PaintingGame
    DoEvents
  Loop Until Quit

  EndGame
End Sub

Sub Initialization()
  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))
  Me.Show
End Sub

Sub PaintingGame()
  CalcMotion
  Call BackBuffer.BltColorFill(EmptyRect, 0)
  subBackStars

  BackBuffer.Lock EmptyRect, EmptyStr, DDLOCK_WRITEONLY, 0
  For n = 0 To MaxBackStars
    For m = 0 To 2
      Call BackBuffer.SetLockedPixel(BackStars.RX(m, n), _
          BackStars.RY(m, n), BackStars.Color(m))
    Next
  Next
  BackBuffer.Unlock EmptyRect

  Call BackBuffer.DrawText( _
      10, 10, "SetLockedPixel zum zeichnen von Sternen", False)
  Call BackBuffer.DrawText( _
      10, 30, "Steuerung erfolgt mit den Pfeiltasten", False)

  Call BackBuffer.DrawText( _
      10, 60, "ShipSteer: " & ShipSteer, False)

  Call BackBuffer.DrawText( _
      10, 80, "ShipSpeedX: " & ShipSpeedX, False)
  Call BackBuffer.DrawText( _
      10, 100, "ShipSpeedy: " & ShipSpeedY, False)

  Primary.Flip Nothing, DDFLIP_WAIT
End Sub

Sub CalcMotion()
  If KeyLeft = True Then ShipSteer = ShipSteer - 0.1
  If KeyRight = True Then ShipSteer = ShipSteer + 0.1

  If KeyUp = True Then
    ShipSpeedX = Cos(ShipSteer) * 20
    ShipSpeedY = Sin(ShipSteer) * 20
  ElseIf KeyDown = True Then
    ShipSpeedX = Cos(ShipSteer) * -20
    ShipSpeedY = Sin(ShipSteer) * -20
  Else
    ShipSpeedX = 0
    ShipSpeedY = 0
  End If
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 subBackStars()
  Dim FastX(2) As Single
  Dim FastY(2) As Single

  With BackStars
    For n = 0 To 2
      FastX(n) = ShipSpeedX / (n + 3)
      FastY(n) = ShipSpeedY / (n + 3)
    Next

    For n = 0 To MaxBackStars
      For m = 0 To 2
        .RX(m, n) = .RX(m, n) - FastX(m)
        If .RX(m, n) > ResolutionX Then .RX(m, n) = .RX(m, n) - _
            ResolutionX
        If .RX(m, n) < 0 Then .RX(m, n) = .RX(m, n) + ResolutionX
        .RY(m, n) = .RY(m, n) - FastY(m)
        If .RY(m, n) > ResolutionY Then .RY(m, n) = .RY(m, n) - _
            ResolutionY
        If .RY(m, n) < 0 Then .RY(m, n) = .RY(m, n) + ResolutionY
      Next
    Next
  End With
End Sub

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