Cálculo de área de un polígono irregular
Realizado en Lazarus
(version para Windows y Gnu/linux)
Hola, os traigo mi primer programa realizado en Lazarus, que es un IDE para FreePascal. Tiene algunas ventajas frente a Gambas, ya que es multiplataforma, osea que puedes crear el programa y compilarlo para varios sistemas operativos (no solo para gnu/linux). Os he dejado al final los enlaces tanto del código fuente como los ejecutables para gnu/linux y windows.
El programa, es una utilidad para el cálculo del area de un poligono irregular (una de las entradas que ha tenido mas visitas en mi blog).
El programa en el ide (ubuntu 10.04)
Os dejo aqui parte del código (el completo esta en el enlace del final del articulo).
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, Grids, Buttons,LCLType;
type
{ TForm1 }
TForm1 = class(TForm)
BotonTablaNueva: TBitBtn;
BotonBorrarFila: TBitBtn;
BotonIntroducirPar: TButton;
Button1: TButton;
ButtonSalirPrograma: TButton;
CalcularArea: TButton;
FilaBorrar: TEdit;
EditX: TEdit;
EditY: TEdit;
GroupBox1: TGroupBox;
LabelAREA: TLabel;
LabelX: TLabel;
LabelY: TLabel;
StringGrid1: TStringGrid;
procedure BotonBorrarFilaClick(Sender: TObject);
procedure BotonIntroducirParClick(Sender: TObject);
procedure BotonTablaNuevaClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ButtonSalirProgramaClick(Sender: TObject);
procedure CalcularAreaClick(Sender: TObject);
procedure EditXChange(Sender: TObject);
procedure EditYChange(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure GroupBox1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
// variables que van a tener los puntos que forman el poligono (maximo 101 puntos)
var x: array [0..100] of Extended;
var y: array [0..100] of Extended;
implementation
//para que pueda abrir el formulario de Acerca de...
uses Unit2;
{$R *.lfm}
{ TForm1 }
procedure TForm1.BotonBorrarFilaClick(Sender: TObject);
var a,fila: integer;
begin
if filaBorrar.text='' then
showmessage('Debe de introducir algun numero')
else
begin
fila:=StrToInt(FilaBorrar.text) ;
if (fila>stringgrid1.rowcount-1) or (fila<1) then
begin
ShowMessage('No puedes borrar esa fila');
FilaBorrar.text:='' ;
end
else
begin
for a:=(StrToInt(FilaBorrar.Text)+1) to stringgrid1.rowcount-1 do
begin
// stringgrid1.Cells[0, a-1]:= stringgrid1.Cells[0, a];
stringgrid1.Cells[1, a-1]:= stringgrid1.Cells[1, a];
stringgrid1.Cells[2, a-1]:= stringgrid1.Cells[2, a];
end;
stringgrid1.rowcount := stringgrid1.rowcount-1;
showmessage('borrado linea') ;
end;
end;
end;
procedure TForm1.BotonIntroducirParClick(Sender: TObject);
begin
stringgrid1.RowCount:= stringgrid1.RowCount+1;
stringgrid1.Cells[0, stringgrid1.RowCount-1]:= FloatToStr(stringgrid1.RowCount-1);
stringgrid1.Cells[1, stringgrid1.RowCount-1]:=editx.text;
stringgrid1.Cells[2, stringgrid1.RowCount-1]:=edity.text;
editx.text:='';
edity.text:='';
end;
procedure TForm1.BotonTablaNuevaClick(Sender: TObject);
begin
stringgrid1.rowcount :=1;
ShowMessage('Reiniciada la tabla de datos');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
try Form2.show;
finally
end;
end;
procedure TForm1.ButtonSalirProgramaClick(Sender: TObject);
begin
close;
end;
procedure TForm1.CalcularAreaClick(Sender: TObject);
var s: double;
var s1: double;
var super: double;
var x_count: integer;
var I,j : integer;
begin
//carga el contenido del gridviews en un array
for I:=1 to stringgrid1.rowcount-1 do
begin
x[I-1]:=StrToFloat(stringgrid1.Cells[1,I]);
y[I-1]:=StrToFloat(stringgrid1.Cells[2,I]);
end;
x_count:=stringgrid1.rowcount-1;
//pasa los datos a una funcion que devuelva el calculo del area
s:=0;
s1:=0;
for j:=0 to x_count-1 do
s:= s+x[j]*y[j+1];
s:=s+x[x_count-1]*y[0] ;
for j:=0 to x_count-1 do s1:=s1+y[j]*x[j+1];
s1:=s1+y[x_count-1]*x[0];
super:= (1/2)*(s-s1);
if super<0 then super:=-super;
LabelAREA.caption:= 'El area es ...' + floattostr(super);
end;
procedure TForm1.EditXChange(Sender: TObject);
begin
end;
procedure TForm1.EditYChange(Sender: TObject);
begin
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
stringgrid1.cells[0,0]:='Coord';
stringgrid1.Cells[1,0]:='X';
stringgrid1.Cells[2,0]:='Y';
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
end;
procedure TForm1.GroupBox1Click(Sender: TObject);
begin
end;
initialization
{$I unit1.lrs}
end.
Os dejo los enlaces de descarga:
Saludos
Nota:
6/nov/2011: Os dejo un video para mostrar como funciona el programa