Le calcul d'une surface quelconque d'un ou de plusieurs polygone

Soyez le premier à donner votre avis sur cette source.

Snippet vu 1 405 fois

Contenu du snippet

{Un système d'équation et une fonction découverte dans un ancien livre à Beaubourg à Paris}
{Ajout de la possibilité d'obtenir le périmètre le 25.07.2017 by Denis Bertin stéphane}
AJOUT: 14/02/2018 par Cirec
Modifications possibles & attentues ;)

function distance(a,b,x,y:integer): real;
 var da,db: real;
 begin
 da:=longint(a)-longint(x);
 db:=longint(b)-longint(y);
 distance:=sqrt(da*da+db*db);
 end;

function o_tabpt.calcul_surface:longint;
  var i,j,debut,xx,yy,xxx,yyy:integer;
     surface,perimetre,a,b,c,d:real;
      point:tpoint;
      tous_inside,inside:boolean;
      aforme:wformes1.Tforme_dessin;
      sur_forme:u_object.tsur;
  begin
 {nw=1 si un seul polygone,}
 if (tab<>nil) and (nw=1) then
  begin
  surface:=0;
  {writeln('début calcul surface')};
  for i:=1 to pred(npt) do
   begin
   a:=tab^[i].x;
   b:=tab^[succ(i)].x;
   c:=tab^[i].y;
   d:=tab^[succ(i)].y;
   surface:=surface+(a+b)*(c-d);
   {writeln('surface=',surface);}
   {writeln(i,'->',a,',',c);}
   end;
    inc(i); {nombre de coordonnées dans le tableau tab^[i]}
  {writeln(i,'->',b,',',d);}
  //calcul_surface:=relation.log_pouce_to_10mm_carre(abs(surface) / 2);
    calcul_surface:=round(abs(surface)/2);
  {writeln('surface fin=',abs(surface) div 2);}
  end
  else if (tab<>nil) and (nw>=2) then {denis B le 06.02.2018}
    begin
    surface:=0;
    debut:=1;
    inside:=true;
    tous_inside:=false;
    if nw=2 then
      begin
      tous_inside:=true;
      xx:=tab^[1].x;
      yy:=tab^[1].y;
      aforme:=wformes1.Tforme_dessin.Create(xx,yy);
      for i:=succ(debut) to pred(debut+tabw^[1]) do
        begin
        xxx:=tab^[i].x-xx;
        yyy:=tab^[i].y-yy;
        aforme.elements.Add(font_ob1.ligneNode.Create(xxx,yyy));
        end;
      aforme.elements.Add(font_ob1.polynode.Create(0,0));
      aforme.calcul;
      inc(debut,tabw^[2]);
      for i:=succ(debut) to pred(debut+tabw^[2]) do
        begin
        point.x:=tab^[i].x;
        point.y:=tab^[i].y;
        if not aforme.listtabpt.sur(point) then {Denis Bertin Stéphane le 06.02.2018}
          tous_inside:=false;
        end;
      aforme.free;
      end;
    debut:=1;
    for j:=1 to nw do
      begin
      for i:=debut to pred(pred(debut+tabw^[j])) do
        begin
        a:=tab^[i].x;
 b:=tab^[succ(i)].x;
 c:=tab^[i].y;
 d:=tab^[succ(i)].y;
        if tous_inside then
          if inside then
            surface:=surface-(a+b)*(c-d)
          else
            surface:=surface+(a+b)*(c-d)
        else
          surface:=surface+(a+b)*(c-d);
        end; {i}
      inc(debut,tabw^[j]);
      inside:=not(inside);
      end; {j}
     calcul_surface:=round(abs(surface)/2);
    end
 else if (tab<>nil) and (nw=0) then //nw=0 si ligne brisée ouverte (Périmetre)
   begin
    perimetre:=0;
    for i:=1 to pred(npt) do
 begin
 a:=tab^[i].x;
 b:=tab^[succ(i)].x;
 c:=tab^[i].y;
 d:=tab^[succ(i)].y;
 perimetre:=perimetre+distance(round(a),round(c),round(b),round(d));
      end;
    calcul_surface:=round(perimetre);
    end
  else
    calcul_surface:=0;
  end; {o_tabpt.calcul_surface}

A voir également

Ajouter un commentaire

Commentaires

Commenter la réponse de denisbertin

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.