Option Explicit

Type strcBild
  X       As Single
  Y       As Single
  DirX    As Single
  DirY    As Single
  Width   As Single
  Height  As Single
End Type

Public BILD(2) As strcBild

Public Const BildBreiteHoehe As Single = 66
Public Const SCREENWIDTH As Single = 800
Public Const SCREENHEIGHT As Single = 600

Public PI As Single
Dim Opposite As Single
Dim Adjacent As Single
Dim Hypotenuse As Single

Public Sub SetPI()
  PI = Atn(1) * 4
End Sub

Function GetDistance(ByVal X1 As Integer, ByVal Y1 As Integer, _
         ByVal X2 As Integer, ByVal Y2 As Integer) As Integer
  On Error GoTo ErrEnd
  Opposite = Abs(X2 - X1)
  Adjacent = Abs(Y1 - Y2)
  Hypotenuse = Sqr(Opposite * Opposite + Adjacent * Adjacent)
  GetDistance = Hypotenuse
  Exit Function
ErrEnd:
  GetDistance = 0
End Function

Function DegToRad(Degrees As Double) As Double
  DegToRad = Degrees / 180 * PI
End Function

Function RadToDeg(Radians As Double) As Double
  RadToDeg = Radians * 180 / PI
End Function

Function GetAngle(ByVal X1 As Integer, ByVal Y1 As Integer, _
       ByVal X2 As Integer, ByVal Y2 As Integer) As Double
  On Error GoTo ErrEnd
  If Y2 = Y1 Then
    If (X2 - X1) < 0 Then GetAngle = 3 * PI / 2
    If (X2 - X1) > 0 Then GetAngle = PI / 2
  Else
    If (Y2 - Y1) > 0 Then GetAngle = Atn((X2 - X1) / (Y2 - Y1))
    If (Y2 - Y1) < 0 Then _
          GetAngle = Atn((X2 - X1) / (Y2 - Y1)) + PI
  End If
  GetAngle = 180 - RadToDeg(GetAngle)
  If GetAngle < 0 Then GetAngle = GetAngle + 360
  Exit Function
ErrEnd:
  GetAngle = 0
End Function

Option Explicit

Dim DX7 As New DirectX7
Dim DD7 As DirectDraw7
Dim SurfaceDesc As DDSURFACEDESC2
Dim PrimarySurface As DirectDrawSurface7
Dim ddPF As DDPIXELFORMAT
Dim BackBuffer As DirectDrawSurface7
Dim bmpBild1 As DirectDrawSurface7

Dim bolKollision As Boolean
Dim running As Boolean
Dim FPSCounter As Single
Dim FPS As Single
Dim FPSTickLast As Long

Private Sub Form_Load()
  Dim Destrect As RECT
  Dim SrcRect As RECT
  Dim i As Single
  Dim hlpAngle As Double

  Me.Show
  Me.Refresh

  Initialization
  BitmapLaden
  SetPI

  BILD(0).X = 250: BILD(0).Y = 10: _
        BILD(0).DirX = 1: BILD(0).DirY = 1
  BILD(1).X = 50: BILD(1).Y = 200: _
        BILD(1).DirX = 0.5: BILD(1).DirY = 1
  BILD(2).X = 300: BILD(2).Y = 400: _
        BILD(2).DirX = 1: BILD(2).DirY = 0.5

  running = True

  Do
    For i = 0 To 2
      If BILD(i).X < 5 Then
        BILD(i).DirX = BILD(i).DirX * -1
      End If
      If BILD(i).Y < 5 Then
        BILD(i).DirY = BILD(i).DirY * -1
      End If
      If BILD(i).X + 10 > (SCREENWIDTH - BildBreiteHoehe) Then
        BILD(i).DirX = BILD(i).DirX * -1
      End If
      If BILD(i).Y + 10 > (SCREENHEIGHT - BildBreiteHoehe) Then
        BILD(i).DirY = BILD(i).DirY * -1
      End If

      BILD(i).X = BILD(i).X + BILD(i).DirX
      BILD(i).Y = BILD(i).Y + BILD(i).DirY

      With SrcRect
        .Left = 0: .Right = BildBreiteHoehe
        .Top = 0: .Bottom = BildBreiteHoehe
      End With

      BackBuffer.BltFast BILD(i).X, BILD(i).Y, bmpBild1, _
            SrcRect, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
    Next i
    bolKollision = False

    If GetDistance(BILD(0).X + 33, BILD(0).Y + 33, _
          BILD(1).X + 33, BILD(1).Y + 33) <= 66 Then
      bolKollision = True
      hlpAngle = GetAngle(BILD(0).X + 33, BILD(0).Y + 33, _
            BILD(1).X + 33, BILD(1).Y + 33)
      BILD(0).DirX = (Sin(DegToRad(hlpAngle)) * -1) * 5
      BILD(0).DirY = (-Cos(DegToRad(hlpAngle)) * -1) * 5
      hlpAngle = GetAngle(BILD(1).X + 33, BILD(1).Y + 33, _
            BILD(0).X + 33, BILD(0).Y + 33)
      BILD(1).DirX = (Sin(DegToRad(hlpAngle)) * -1) * 5
      BILD(1).DirY = (-Cos(DegToRad(hlpAngle)) * -1) * 5
    End If

    If GetDistance(BILD(0).X + 33, BILD(0).Y + 33, _
          BILD(2).X + 33, BILD(2).Y + 33) <= 66 Then
      bolKollision = True
      hlpAngle = GetAngle(BILD(0).X + 33, BILD(0).Y + 33, _
            BILD(2).X + 33, BILD(2).Y + 33)
      BILD(0).DirX = (Sin(DegToRad(hlpAngle)) * -1) * 5
      BILD(0).DirY = (-Cos(DegToRad(hlpAngle)) * -1) * 5
      hlpAngle = GetAngle(BILD(2).X + 33, BILD(2).Y + 33, _
            BILD(0).X + 33, BILD(0).Y + 33)
      BILD(2).DirX = (Sin(DegToRad(hlpAngle)) * -1) * 5
      BILD(2).DirY = (-Cos(DegToRad(hlpAngle)) * -1) * 5
    End If

    If GetDistance(BILD(1).X + 33, BILD(1).Y + 33, _
          BILD(2).X + 33, BILD(2).Y + 33) <= 66 Then
      bolKollision = True
      hlpAngle = GetAngle(BILD(1).X + 33, BILD(1).Y + 33, _
            BILD(2).X + 33, BILD(2).Y + 33)
      BILD(1).DirX = (Sin(DegToRad(hlpAngle)) * -1) * 5
      BILD(1).DirY = (-Cos(DegToRad(hlpAngle)) * -1) * 5
      hlpAngle = GetAngle(BILD(2).X + 33, BILD(2).Y + 33, _
            BILD(1).X + 33, BILD(1).Y + 33)
      BILD(2).DirX = (Sin(DegToRad(hlpAngle)) * -1) * 5
      BILD(2).DirY = (-Cos(DegToRad(hlpAngle)) * -1) * 5
    End If

    BackBuffer.SetForeColor vbRed
    BackBuffer.SetFont Me.Font
    BackBuffer.DrawText 10, 10, "DirectDraw und Bitmaps-" & _
          "Kollisionsüberprüfung via Distanzberechnung", False
    BackBuffer.DrawText _
          10, 30, "<Esc> beendet das Programm", False
    BackBuffer.DrawText _
          10, 50, "FPS: " & Format(FPS, "0.0"), False

    If bolKollision Then
      BackBuffer.DrawText 10, 70, "Kollision", False
    End If

    PrimarySurface.Flip Nothing, DDFLIP_WAIT

    ClearBuffer vbBlack

    If FPSCounter = 30 Then
      If FPSTickLast <> 0 Then _
            FPS = 1000 * 30 / (GetTime - FPSTickLast) + 1
      FPSTickLast = GetTime
      FPSCounter = 0
    End If
    FPSCounter = FPSCounter + 1

    DoEvents
  Loop While running

  Terminate
End Sub

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

Sub Initialization()
  Set DD7 = DX7.DirectDrawCreate("")
  DD7.SetCooperativeLevel Me.hWnd, DDSCL_EXCLUSIVE Or _
        DDSCL_FULLSCREEN Or DDSCL_ALLOWREBOOT
  DD7.SetDisplayMode SCREENWIDTH, SCREENHEIGHT, 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 ddPF
End Sub

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

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

  BmpDesc.lWidth = 66: BmpDesc.lHeight = 66

  Set bmpBild1 = _
      DD7.CreateSurfaceFromFile(App.Path & "\Objekt.bmp", BmpDesc)

  ColorKey.high = (ddPF.lRBitMask + ddPF.lBBitMask)
  ColorKey.low = (ddPF.lRBitMask + ddPF.lBBitMask)
  bmpBild1.SetColorKey DDCKEY_SRCBLT, ColorKey
End Sub

Sub Terminate()
  Set bmpBild1 = 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 = SCREENHEIGHT
    .Left = 0
    .Right = SCREENWIDTH
    .Top = 0
  End With
  BackBuffer.BltColorFill Destrect, Color
End Sub

Function GetTime() As Long
  GetTime = DX7.TickCount
End Function