Thread: JS: Brauche komplizierte math. Flächenberechnung

Option Explicit
 
Public Type Vector
    x As Single
    y As Single
End Type
 
Dim loPolygon() As Vector
Dim loTest As Vector
Dim liPolysize As Long
Dim lbTestSet As Boolean
 
Public Sub init()
    loTest.x = 0
    loTest.y = 0
    liPolysize = -1
    lbTestSet = False
End Sub
 
Public Sub clearPolygon()
    ReDim loPolygon(0)
    liPolysize = -1
    lbTestSet = False
    Form1.picGrid.Cls
    drawGrid
End Sub
 
Public Sub addPolyVector(x As Single, y As Single)
    Dim vec As Vector
    vec.x = x
    vec.y = y
    liPolysize = liPolysize + 1
    ReDim Preserve loPolygon(liPolysize)
    loPolygon(liPolysize) = vec
End Sub
 
Public Sub setTestVector(x As Single, y As Single)
    loTest.x = x
    loTest.y = y
    lbTestSet = True
End Sub
 
Public Sub drawGrid()
    Dim i As Integer
    Form1.picGrid.DrawWidth = 1
    Form1.picGrid.ForeColor = RGB(200, 200, 200)
    For i = 1 To Form1.picGrid.ScaleWidth - 1
        Form1.picGrid.Line (i, 0)-(i, Form1.picGrid.ScaleHeight)
    Next i
    For i = 1 To Form1.picGrid.ScaleHeight - 1
        Form1.picGrid.Line (0, i)-(Form1.picGrid.ScaleWidth, i)
    Next i
End Sub
 
 
Public Sub Repaint()
    Dim i As Integer
    Form1.picGrid.Cls
 
    drawGrid
    
    If (liPolysize >= 0) Then
        Form1.picGrid.ForeColor = RGB(0, 0, 0)
        Form1.picGrid.DrawWidth = 5
        Form1.picGrid.PSet (loPolygon(0).x, loPolygon(0).y)
        Form1.picGrid.DrawWidth = 1
        
        For i = 0 To UBound(loPolygon) - 1
            Form1.picGrid.DrawWidth = 5
            Form1.picGrid.PSet (loPolygon(i + 1).x, loPolygon(i + 1).y)
            Form1.picGrid.DrawWidth = 1
            Form1.picGrid.Line (loPolygon(i).x, loPolygon(i).y)-(loPolygon(i + 1).x, loPolygon(i + 1).y)
        Next i
        Form1.picGrid.Line (loPolygon(UBound(loPolygon)).x, loPolygon(UBound(loPolygon)).y)-(loPolygon(0).x, loPolygon(0).y)
    End If
    
    If (lbTestSet) Then
        If (isInPolygon()) Then
            Form1.picGrid.ForeColor = RGB(0, 200, 0)
            Form1.lblStatus.Caption = "Testpunkt (" & Round(loTest.x, 2) & ";" & Round(loTest.y, 2) & ") liegt innerhalb des Polygons"
 
        Else
            Form1.picGrid.ForeColor = RGB(200, 0, 0)
            Form1.lblStatus.Caption = "Testpunkt (" & Round(loTest.x, 2) & ";" & Round(loTest.y, 2) & ") liegt außerhalb des Polygons"
        End If
        Form1.picGrid.DrawWidth = 5
        Form1.picGrid.PSet (loTest.x, loTest.y)
    End If
End Sub
 
Public Function isInPolygon() As Boolean
    Dim i As Integer
    Dim a As Vector
    Dim b As Vector
    Dim phi As Double
    Dim nexti As Long
    Dim tmp As Double
    
    phi = 0
    
    If (liPolysize > 0) Then
        ' es werden ausgehend vom testpunkt jeweils zwei aufeinanderfolgende punkte im polygon betrachtet:
        ' nach ermitteln der richtungsvektoren der geraden zwischen dem testpunkt und punkt i im polygon,
        ' sowie testpunkt und punkt i+1 im polygon kann der schnittwinkel der beiden richtungsvektoren
        ' berechnet werden. alle winkel werden summiert. liegt der testpunkt innerhalb des polygons, so
        ' ergibt die summe aller winkel (+-)360°, da beim ermitteln der schnittwinkel einmal vollständig
        ' um den testpunkt gedreht werden muß.
        ' liegt der testpunkt außerhalb, so ergibt die summe aller winkel genau 0, da nach links genauso
        ' weit gedreht werden muß, wie nach rechts.
        For i = 0 To UBound(loPolygon)
            ' es werden immer 2 benachbarte punkte des polygons p0..pn benötigt, um im letzten schritt die
            ' punkte pn und p1 zu erhalten wird zunächst der folgevektor pi+1 mit hilfe des modulo operators
            ' ermittelt. dadurch erhält man im n-ten schritt wieder den vektor p0 des polygons
            nexti = (i + 1) Mod (UBound(loPolygon) + 1)
            
            ' richtungsvektor der geraden vom testpunkt zum i-ten punkt im polygon
            a.x = loPolygon(i).x - loTest.x
            a.y = loPolygon(i).y - loTest.y
            ' richtungsvektor der geraden vom testpunkt zum (i+1)-ten punkt im polygon
            b.x = loPolygon(nexti).x - loTest.x
            b.y = loPolygon(nexti).y - loTest.y
            
            ' die geraden mit richtungsvektoren a und b schneiden sich zwangsläufig im schnittpunkt loTest
            ' wodurch der schnittwinkel zwischen den richtungsvektoren a und b wie folgt berechnet werden
            ' kann:
            '              /  (a*b)  \          /           a.x*b.x + a.y*b.y           \
            ' phi = arccos | ------- | = arccos | ------------------------------------- |
            '              \ |a|*|b| /          \ sqrt(a.x^2+a.y^2) * sqrt(b.x^2+b.y^2) /
            ' da arccos das ergebnis in rad liefert muß anschließend noch durch PI/180 dividiert werden um
            ' das ergebnis in grad zu erhalten. da PI in vb nicht deklariert ist, wird der wert duch 4*arctan(1)
            ' ermittelt.
            tmp = arccos(((a.x * b.x + a.y * b.y) / ((a.x ^ 2 + a.y ^ 2) ^ (1 / 2) * (b.x ^ 2 + b.y ^ 2) ^ (1 / 2)))) / (4 * Atn(1) / 180)
            
            ' anschließend wird noch das vorzeichen des winkels benötigt. dies erhält man aus den koordinaten
            ' des testpunktes und der beiden punkte, die aktuell geprüft werden.
            tmp = tmp * Sign((loPolygon(i).x - loTest.x) * (loPolygon(nexti).y - loTest.y) - (loPolygon(i).y - loTest.y) * (loPolygon(nexti).x - loTest.x))
            
            ' nun nur noch den neu berechneten winkel auf die bisher berechnete summe addieren
            phi = phi + tmp
        Next i
        ' ist der winkel 0° (alle winkel heben sich auf), so liegt der punkt außerhalb des polygons, in allen
        ' anderen fällen beträgt der winkel 360° und der testpunkt liegt innerhalb des polygons.
        ' aufgrund der schlechten kondition bei der berechnung etwas spielraum erlauben. besser wäre es, den
        ' absoluten fehler zu berechnen und die toleranz nur in diesem bereich zu gestatten.
        isInPolygon = Not (phi < 5 And phi > -5)
    End If
End Function
 
' arcus cosinus mit hilfe anderer trigonometrischen funktionen berechnen, da arccos in vb6 fehlt
Public Function arccos(n As Double) As Double
    arccos = Atn(-n / Sqr(-n * n + 1)) + 2 * Atn(1)
End Function
 
' funktion zum ermitteln des vorzeichens einer zahl (rückgabe: -1;0;1)
Public Function Sign(n As Double) As Integer
    If (n < 0) Then
        Sign = -1
    ElseIf (n > 0) Then
        Sign = 1
    Else
        Sign = 0
    End If
End Function