Tipp 0294 Linienkollision
Autor/Einsender:
Datum:
  Sebastian Bauersfeld
07.12.2002
Entwicklungsumgebung:   VB 6
Das Beispiel soll zeigen, wie man die Kollision zwischen zwei Linien überprüft. Diese Art der Kollision ist nicht unbedingt einfach, da man einige Spezialfälle beachten muss.
Code im Codebereich des Moduls m_LineCollision
 
Option Explicit

Public Function ProofLineCollision(ByVal L1_X1 As Single, _
            ByVal L1_Y1 As Single, ByVal L1_X2 As Single, _
            ByVal L1_Y2 As Single, ByVal L2_X1 As Single, _
            ByVal L2_Y1 As Single, ByVal L2_X2 As Single, _
            ByVal L2_Y2 As Single) As Boolean

  'Anstiege
  Dim L1_m As Single, L2_m As Single
  'Schnittpunkte mit der Ordinatenachse
  Dim L1_n As Single, L2_n As Single
  'Schnittpunkt der Linien
  Dim s    As Single
  'Hilfsvariablen für X- und Y- Werte
  Dim h_Y  As Single, h_X  As Single

  'X- und Y- Werte vertauschen, falls X2 < X1
  '(nur ein Problem mathematischer Natur)
  If L1_X2 < L1_X1 Then
    SwitchVar L1_X1, L1_X2
    SwitchVar L1_Y1, L1_Y2
  End If

  If L2_X2 < L2_X1 Then
    SwitchVar L2_X1, L2_X2
    SwitchVar L2_Y1, L2_Y2
  End If

  'X- und Y- Werte vertauschen, falls Y2 < Y1 und X1 = X2
  If L1_X1 = L1_X2 And L1_Y2 < L1_Y1 Then
    SwitchVar L1_X1, L1_X2
    SwitchVar L1_Y1, L1_Y2
  End If

  If L2_X1 = L2_X2 And L2_Y2 < L2_Y1 Then
    SwitchVar L2_X1, L2_X2
    SwitchVar L2_Y1, L2_Y2
  End If

  'Beide Linien senkrecht
  If L1_X1 = L1_X2 And L2_X1 = L2_X2 Then
    'Prüfen, ob Linien aufeinanderliegen
    ProofLineCollision = (L1_X1 = L2_X1 And _
          ((L1_Y1 >= L2_Y1 And L1_Y1 <= L2_Y2) Or _
          (L2_Y1 >= L1_Y1 And L2_Y1 <= L1_Y2)))
    Exit Function
  End If

  'Beide Linien waagerecht
  If L1_Y1 = L1_Y2 And L2_Y1 = L2_Y2 Then
    'Prüfen, ob Linien aufeinanderliegen
    ProofLineCollision = (L1_Y1 = L2_Y1 And _
          ((L1_X1 >= L2_X1 And L1_X1 <= L2_X2) Or _
          (L2_X1 >= L1_X1 And L2_X1 <= L1_X2)))
    Exit Function
  End If

  'Nur eine der Linien ist senkrecht, die andere waagerecht
  If L1_X1 = L1_X2 And L2_Y1 = L2_Y2 Then
    ProofLineCollision = (L1_X1 >= L2_X1 And L1_X1 <= L2_X2 _
                      And L2_Y1 >= L1_Y1 And L2_Y1 <= L1_Y2)
    Exit Function

  'nochmal umgekehrt
  ElseIf L1_Y1 = L1_Y2 And L2_X1 = L2_X2 Then
    ProofLineCollision = (L1_Y1 >= L2_Y1 And L1_Y1 <= L2_Y2 _
                      And L2_X1 >= L1_X1 And L2_X1 <= L1_X2)
    Exit Function
  End If

  'Eine Linie ist senkrecht, die andere ist diagonal
  If L1_X1 = L1_X2 Then
    'Anstieg und Schnittpunkt mit der Ordinatenachse für Linie2
    L2_m = (L2_Y2 - L2_Y1) / (L2_X2 - L2_X1)
    L2_n = L2_Y2 - L2_m * L2_X2

    h_Y = L2_m * L1_X1 + L2_n

    ProofLineCollision = (L1_X1 >= L2_X1 And L1_X1 <= L2_X2 _
                      And h_Y >= L1_Y1 And h_Y <= L1_Y2)
    Exit Function

  'nochmal umgekehrt
  ElseIf L2_X1 = L2_X2 Then
    'Anstieg und Schnittpunkt mit der Ordinatenachse für Linie1
    L1_m = (L1_Y2 - L1_Y1) / (L1_X2 - L1_X1)
    L1_n = L1_Y2 - L1_m * L1_X2

    h_Y = L1_m * L2_X1 + L1_n

    ProofLineCollision = (L2_X1 >= L1_X1 And L2_X1 <= L1_X2 And _
                          h_Y >= L2_Y1 And h_Y <= L2_Y2)
    Exit Function
  End If

  'Eine Linie ist waagerecht, die andere ist diagonal
  If L1_Y1 = L1_Y2 Then
    'Anstieg und Schnittpunkt mit der Ordinatenachse für Linie2
    L2_m = (L2_Y2 - L2_Y1) / (L2_X2 - L2_X1)
    L2_n = L2_Y2 - L2_m * L2_X2

    h_X = (L1_Y1 - L2_n) / L2_m

    ProofLineCollision = (h_X >= L1_X1 And h_X <= L1_X2 And _
                          h_X >= L2_X1 And h_X <= L2_X2)
    Exit Function

  'nochmal umgekehrt
  ElseIf L2_Y1 = L2_Y2 Then
    'Anstieg und Schnittpunkt mit der Ordinatenachse für Linie1
    L1_m = (L1_Y2 - L1_Y1) / (L1_X2 - L1_X1)
    L1_n = L1_Y2 - L1_m * L1_X2

    h_X = (L2_Y1 - L1_n) / L1_m

    ProofLineCollision = (h_X >= L2_X1 And h_X <= L2_X2 And _
                          h_X >= L1_X1 And h_X <= L1_X2)
    Exit Function
  End If

  'Wenn beide Linien diagonal sind...
  'Anstieg und Schnittpunkt mit der Ordinatenachse für Linie1
  L1_m = (L1_Y2 - L1_Y1) / (L1_X2 - L1_X1)
  L1_n = L1_Y2 - L1_m * L1_X2

  'Anstieg und Schnittpunkt mit der Ordinatenachse für Linie2
  L2_m = (L2_Y2 - L2_Y1) / (L2_X2 - L2_X1)
  L2_n = L2_Y2 - L2_m * L2_X2

  'Linien sind eventuell parallel zueinander
  If L2_m = L1_m Then
    ProofLineCollision = _
          (L1_m * L1_X1 + L1_n = L2_m * L1_X1 + L2_n And _
           L1_X1 >= L2_X1 And L1_X1 <= L2_X2)
    Exit Function

  'Wenn nicht, Schnittpunkt errechnen
  Else
    s = (L1_n - L2_n) / (L2_m - L1_m)
  End If

  'Überprüfen, ob der Schnittpunkt innerhalb beider Linien liegt
  ProofLineCollision = (s >= L1_X1 And s <= L1_X2 And _
                        s >= L2_X1 And s <= L2_X2)
End Function

'Dient zum Vertauschen von zwei Variablen
Public Sub SwitchVar(ByRef a As Single, ByRef b As Single)
  Dim dummy As Long

  dummy = a
  a = b
  b = dummy
End Sub
 
Code im Codebereich der Form
 
Option Explicit

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
        X As Single, Y As Single)

  Line1.X1 = X
  Line1.Y1 = Y

  If ProofLineCollision(Line1.X1, Line1.Y1, Line1.X2, Line1.Y2, _
          Line2.X1, Line2.Y1, Line2.X2, Line2.Y2) Then
    Me.Caption = "  »»»  Kollision !!!!  «««"
  Else
    Me.Caption = "Kollision zwischen zwei Linien"
  End If
End Sub
 
Weitere Links zum Thema
Kollision 2D
DirectX
Kollisionserkennung (GetLockedPixel)
Kollisionserkennung (Pixel und Rechteck)
Kollisionserkennung (Distanz-Berechnung)
Kollisionserkennung (RECT)

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  (3,9 kB) Downloads bisher: [ 1412 ]

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: Montag, 12. September 2011