Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Mathematik

Flächenberechnung eines Polygons

Lizenz:Erster Autor:Letzte Bearbeitung:
k. A.Redakteurytwinky 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 natrlich 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 Redakteurytwinky angelegt.
  • Die aktuellste Version wurde am 20.08.2010 von Redakteurytwinky gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen