juego: Desenrolla el hilo

Desenrolla el hilo: uso de clases y observador en Gambas

Este es un simple juego, donde tenemos que quitar las intersecciones que se producen (puntos verdes) en los cruces, moviendo los nudos rojos,  consiguiendo desenrollar el hilo.


Enlace de descarga del código fuente: ObservarDibujo-0.0.2.tar.gz

Codigo fuente en google drive:  ObservarDibujo-0.0.2.tar.gz

Una imagen del final del juego:

Es un ejemplo de uso de clases y observador

Lo mas interesante del juego, es el uso de las clases (coordenadas, ecuación, etc), y el observador, para mover los circulos rojos.

Aqui teneis un video para explicaros como se juega:

Saludos

Mi primer programa en Lazarus: Calculo del area de un poligono irregular (version para Windows y GNU/Linux)

 

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:

codigo fuente

ejecutable para windows

ejecutable para gnu/linux

Saludos

Nota:

6/nov/2011: Os dejo un video para mostrar como funciona el programa