Code-Beispiel
Flächenberechnung eines Polygons
| Lizenz: | Erster Autor: | Letzte Bearbeitung: |
| k. A. |  ytwinky |  20.08.2010 |
Mit diesem Programm läßt sich die Fläche eines ebenen Polygons berechnen.
Es ist wichtig, daß die Punkte des Polygons in aufeinanderfolgender Reihenfolge eingegeben werden(ob im Uhrzeigersinn oder entgegen ist egal, da Abs() benutzt wird)^^
Aus den Anmerkungen im Programm geht hervor, welche Zeilen für den praktischen Einsatz der Funktion nicht benötigt werden, dadurch wird sie schneller..
Fröhliches Flächenberechnen
'program flaeche;
Const iMax=50, Esc=!"\27"
Type Real As Single
Type Koordinaten
As Real y, x
End Type
Sub PrList(ub As Integer, Objekt() As Koordinaten)
Dim As String mc, k=" ####.###"
Dim As Integer lb=LBound(Objekt)
Print "Koordinatenliste"
Print "LBound=" &lb &" UBound=" &ub
Print "Nr. y x"
For i As Integer=lb To ub
Print Using"P0#";(i+1);
Print Using k; Objekt(i).y;
Print Using k; Objekt(i).x
Next i
mc=Input(1)
End Sub
Function FlaecheNachGauss(ub As Integer, Objekt() As Koordinaten)As Koordinaten
Dim As Integer lb=LBound(Objekt), j
Dim As Koordinaten Tmp
' PrList(ub, Objekt())
With Tmp
.y=0.0
.x=0.0 'Diese Zeile kann entfernt werden, wenn die Kontrolle unnötig ist
For j=lb To ub
.y+=Objekt(j).y*(Objekt(IIf(j=ub, lb, j+1)).x-Objekt(IIf(j=lb, ub, j-1)).x)
.x+=Objekt(j).x*(Objekt(IIf(j=ub, lb, j+1)).y-Objekt(IIf(j=lb, ub, j-1)).y)
'die .x+=..-Zeile kann entfernt werden
Next j
.y=Abs(.y/2.0)
.x=Abs(.x/2.0) 'nur entfernen, wenn oben die .x-Zeilen entfernt wurden
End With
Return Tmp
End Function
Dim Objekt() As Koordinaten
Dim As Koordinaten Flaeche
Dim As Integer i=0, AktDim
Dim dF As Real
Dim mc As String
Cls
Print "Fl„chenberechnung nach GAUSS ¸2008 by ytwinky, MD"
Print "e=eingebautes Beispiel berechnen"
Print "m=manuelle Eingabe eines Beispiels"
Print "Was darf's denn sein?";
Do
mc=lcase(Input(1))
Loop Until InStr("em" &Esc, mc)
Print mc
Select Case mc
Case "e"
AktDim=3
ReDim Objekt(0 To AktDim) As Koordinaten
Objekt(0).y=50:Objekt(0).x=50
Objekt(1).y=50:Objekt(1).x=100
Objekt(2).y=100:Objekt(2).x=100
Objekt(3).y=100:Objekt(3).x=50
Case "m"
Do
Input "Wieviel Punkte hat das Objekt?", AktDim
Loop Until AktDim>2
AktDim-=1
ReDim Objekt(0 To AktDim) As Koordinaten
For i=0 To AktDim
mc="" &(i+1) &":"
Print "Y" &mc;
Input ;"", Objekt(i).y
Locate , Pos()+3
Print "X" &mc;
Input "", Objekt(i).x
Next
Print
Case Else: End
End Select
PrList(AktDim,Objekt())
Flaeche=FlaecheNachGauss(AktDim, Objekt())
With Flaeche
dF=.y-.x
Print "Fl„che(mit y berechnet)=" &.y &_
!"\nFl„che(mit x berechnet)=" &.x &_
!"\nAbweichung=" &dF
If dF<>0 Then Print "(Die beiden Fl„chen sollten natrlich identisch sein..)"
If mc="e" Then Print "Bei dem Beispiel MUSS 2500 das Ergebnis sein.."
End With
Print "Eniki..";
GetKey
End '.Gruß
ytwinky
| Zusätzliche Informationen und Funktionen |
|---|
- Das Code-Beispiel wurde am 04.02.2008 von ytwinky angelegt.
- Die aktuellste Version wurde am 20.08.2010 von ytwinky gespeichert.
|
|
Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!
Bearbeiten
Versionen