vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Top-Preis! AP-Access-Tools-CD Volume 1  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2019
 
zurück
Rubrik: Variablen/Strings · Algorithmen/Mathematik   |   VB-Versionen: VB4, VB5, VB626.02.04
Polygon zeichnen + Flächenberechnung nach Gauss

Dieses Beispiel zeigt, wie sich mit der Maus beliebige Polygone zeichnen und abschließend deren Flächeninhalte mit Hilfe des Gauss'schen Algorithmus berechnen lassen.

Autor:   Malte TreckmannBewertung:     [ Jetzt bewerten ]Views:  31.478 
ohne HomepageSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Erst vor kurzem wurde im Forum gefragt, wie man mit der Maus ein Polygon zeichnen kann und abschließend dann den Flächeninhalt berechnet.

Erstellen Sie ein neues Projekt und platzieren auf die Form eine PictureBox. Setzen Sie die PictureBox-Eigenschaft AutoRedraw auf den Wert True. Per Linksklick sollen die einzelne Eckpunkte des Polygons gesetzt werden. Die jeweiligen Verbindungslinien werden dann autom. gezeichnet. Per Rechtsklick soll das Polygon geschlossen werden. Anschließend erfolgt noch die Berechnung des Flächeninhaltes und wird in der Titelzeile der Form ausgegeben.

Fügen Sie folgenden Code in den Codeteil der Form ein:

Option Explicit
 
' G A U S S - F L Ä C H E
' =======================
' 
' Malte Treckmann
' 
' Berechnug von Polygonflächen, deren Eckpunkte koordinatenmässig bekannt sind
' mit Hilfe der Trapezformel von Gauss.
' Siehe:
' Witte/Schmidt, Vermessungskunde und Grundlagen der Statistik für das Bauwesen, S. 241
' Hagebusch, Fachkunde für Vermessungstechniker, S. 78
' 
' Die Trapezformel befindet sich im Modul mod_gauss_area.
' Mit dem Programm können mit der Maus Polygone gezeichnet werden
' (Schliessen eines Polygons mit rechter Maustaste) und die eingeschlossene
' Fläche wird ermittelt.
' Zur eigenen Kontrolle werden die Seitenlängen des Polygons ausgegeben.
 
Dim punkte() As Double   ' Polygonkoordinaten
Dim zeichnet As Boolean  ' Status-Flag
Dim x_s, y_s As Double   ' Startpunkt
Dim x_m, y_m As Double   ' Mausposition
Dim x_p, y_p As Double   ' letzter gezeichneter Punkt
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, _
  X As Single, Y As Single)
 
  Select Case zeichnet
    Case False
      If Button = vbLeftButton Then
        ' eine neue Zeichnung beginnt
        zeichnet = True
 
        ' Koordinaten des Startpunktes
        x_s = X
        y_s = Y
 
        ' zum Zeichnen
        x_p = X
        y_p = Y
 
        ' zum Rechnen
        anz_punkte = 0
        ReDim punkte(1, anz_punkte)
        punkte(0, 0) = X
        punkte(1, 0) = Y
      End If
 
    Case True
      If Button = vbLeftButton Then
        ' eine Zeichnung wird weitergeführt
 
        ' zum Zeichnen
        Picture1.Line (x_p, y_p)-(X, Y)
        x_p = X
        y_p = Y
 
        ' zum Rechnen
        anz_punkte = anz_punkte + 1
        ReDim Preserve punkte(1, anz_punkte)
        punkte(0, anz_punkte) = X
        punkte(1, anz_punkte) = Y
      End If
 
      If Button = vbRightButton Then
        ' eine Zeichnung wird beendet
        zeichnet = False
 
        ' löscht die aktuell angezeigte Linie
        Picture1.Line (x_p, y_p)-(X, Y), &H8000000F
 
        ' schliesst das Polygon
        Picture1.Line (x_p, y_p)-(x_s, y_s)
 
        ' Ausgabe der Polygonfläche
        Me.Caption = Format(gauss_area(punkte()), "###0.00")
      End If
  End Select
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, _
  X As Single, Y As Single)
 
  Dim s As String
 
  Select Case zeichnet
    Case True
      ' alte Linie löschen
      Picture1.Line (x_p, y_p)-(x_m, y_m), &H8000000F
 
      x_m = X
      y_m = Y
 
      ' neue Linie zeichnen
      Picture1.Line (x_p, y_p)-(x_m, y_m)
 
      ' Länge der aktuellen Linie
      s = "Länge: " + Format(CStr(Sqr((x_p - x_m) ^ 2 + (y_p - y_m) ^ 2)), "###0.00")
      Me.Caption = s
 
    Case False
      ' es passiert nix
  End Select
End Sub
Private Sub Form_DblClick()
  ' Zeichnung löschen
  Picture1.Cls
  Me.Caption = ""
End Sub

Fehlt jetzt nur noch die Funktion gauss_area zum Berechnen des Flächeninhaltes des Polygons:

Im Modul:

Option Explicit
 
Public anz_punkte As Integer       ' Zähler
Public Function gauss_area(punkte() As Double) As Double
  ' Berechnet die Fläche eines Polygons, das durch
  ' Punktkoordinaten gegeben ist
  Dim i As Integer
  Dim Area As Double
  Dim xs, ys, xa, ya As Double
 
  xs = punkte(0, 0)
  ys = punkte(1, 0)
 
  For i = 0 To anz_punkte
    xa = punkte(0, i)
    ya = punkte(1, i)
 
    Area = Area + (ys + ya) * (xs - xa)
 
    xs = xa
    ys = ya
  Next i
 
  ' der letzte Punkt ist wieder der erste Punkt
  xa = punkte(0, 0)
  ya = punkte(1, 0)
 
  Area = Area + (ys + ya) * (xs - xa)
 
  ' Rückgabewert
  gauss_area = Abs(Area) / 2
End Function

Dieser Tipp wurde bereits 31.478 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2019 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel