No es el ejemplo mas pulcro. todo me salio del mi mente así que seguro tiene fallos. Esta hecho en Free Pascal usando como IDE Lazarus.
Imagen:
Codigo:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
windows, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
ExtCtrls, ComCtrls;
type
Circle=record
X:Integer;
Y:Integer;
Color:TColor;
Size:integer;
Rad:double; //Radius
end;
{ TForm1 }
TForm1 = class(TForm)
StatusBar1: TStatusBar;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormPaint(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
procedure CreateFood;
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
aP: array of Circle; //Snake Array
iP:Circle; //Foods
Direction:word;
nColor:integer;
iBalls:integer=1; //Number of Balls for the Snake it starts with 1
iStep:integer;
iSize:integer;
iHeight:integer;
iLevel:integer=1;
iFoods:Integer=0;
iSpeed:Integer=200;
nBalls:integer=10; //Number of balls for the filed nballs*nBalls
implementation
{$R *.lfm}
{ TForm1 }
//Procedure to put a random position for The Food
Procedure TForm1.CreateFood;
var mColor:integer;
begin
repeat
Randomize;
iP.X:=Random(round(Form1.Width/iSize)-1)*iSize;
iP.Y:=Random(round(iHeight/iSize)-1)*iSize;
mColor:=form1.Canvas.Pixels[iP.X+round(iP.Rad),iP.Y+round(iP.Rad)]
until ((mColor <> clred ) and (mColor <> clGreen) ) ;
end;
procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
iSize:=30;
Timer1.Interval:=iSpeed;
Form1.Caption:='Snake Example';
Form1.Color:=clBlack;
Form1.Width:=iSize*nBalls;
Form1.Height:=(iSize*nBalls)+StatusBar1.Height;
iHeight:=Form1.Height-StatusBar1.Height;
Form1.BorderStyle:=bsSingle;
SetLength(aP,iBalls);
StatusBar1.Panels.Add;
StatusBar1.Panels.Add;
StatusBar1.Panels.Add;
StatusBar1.Panels[0].Width:=round(Form1.Width/3);
StatusBar1.Panels[1].Width:=round(Form1.Width/3);
StatusBar1.Panels[2].Width:=round(Form1.Width/3);
StatusBar1.Panels[0].Text:='Points: ' + inttostr(iFoods);
StatusBar1.Panels[1].Text:='Level: '+ Inttostr(iLevel);
StatusBar1.Panels[2].Text:='Speed: ' + inttostr(iSpeed) + ' ms';
iStep:=iSize; // snake step base in Size of balls
with Canvas do
begin
pen.width := 1;
pen.Color:=clWhite;
end;
For i:=0 to iBalls-1 do
begin
aP[i].X:=0;
aP[i].Y:=0;
aP[i].Size:=iSize;
aP[i].Rad:=aP[i].Size/2;
aP[i].Color:=clRed;
end;
//Create the food
iP.Size:=iSize;
iP.Rad:=iP.Size/2;
iP.Color:=clgreen;
CreateFood;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
If Timer1.Enabled=false then Timer1.Enabled:=true;
//assign Direction variable
case Key of
VK_LEFT: Direction:=VK_LEFT; //Left
VK_RIGHT:Direction:=VK_RIGHT; //Right
VK_UP: Direction:=VK_UP; //Up
VK_DOWN: Direction:=VK_DOWN; //Down
end;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
i:integer;
begin
for i:=0 to Length(aP)-1 do
//Draw Snake
begin
Form1.Canvas.Brush.Color:=aP[i].Color;
canvas.Ellipse(aP[i].X,aP[i].Y,aP[i].Size+aP[i].X,aP[i].Size+aP[i].Y);
end;
//Draw Food
Form1.Canvas.Brush.Color:=iP.Color;
canvas.Ellipse(iP.X,iP.Y,iP.Size+iP.X,iP.Size+iP.Y);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
i:integer;
iLastIndex:integer;
sMessage:string;
begin
//add every ball of our snake base on the forward ball position.
for i:=Length(aP)-1 downto 1 do
begin
aP[i].X:=aP[i-1].X;
aP[i].Y:=aP[i-1].Y;
end;
//go forward base on the last direction
case Direction of
VK_LEFT: if not(aP[0].X<=0) then aP[0].X-=iStep; //Left
VK_RIGHT:if not(aP[0].X>=Form1.Width-aP[0].Size) then aP[0].X+=iStep; //Right
VK_UP: if not(aP[0].Y<=0) then aP[0].Y-=iStep; //Up
VK_DOWN: if not(aP[0].Y>=iHeight-aP[0].Size) then aP[0].Y+=iStep; //Down
end;
nColor:=form1.Canvas.Pixels[aP[0].X+round(aP[0].Rad),aP[0].Y+round(aP[0].Rad)];
//check for lose or win
if (((nColor=clRed) and (Length(aP)>1)) or ((Length(aP))=round(nBalls*nBalls))) then
begin
sMessage:='You Lose :(';
if ((Length(aP)) = (round(nBalls*nBalls))) then sMessage:='You Win :)';
If Timer1.Enabled=true then Timer1.Enabled:=false;
Application.MessageBox('The Game will be reset when any key control been pressed',PChar(sMessage), MB_ICONEXCLAMATION);
//Reset Game
Direction:=0;
SetLength(aP,1);
aP[0].X:=0;
aP[0].Y:=0;
aP[0].Size:=iSize;
aP[0].Rad:=aP[i].Size/2;
aP[0].Color:=clRed;
iFoods:=0;
iLevel:=0;
iSpeed:=200;
Timer1.Interval:=iSpeed;
StatusBar1.Panels[0].Text:='Points: ' + inttostr(iFoods);
StatusBar1.Panels[1].Text:='Level: '+ Inttostr(iLevel);
StatusBar1.Panels[2].Text:='Speed: ' + inttostr(iSpeed) + ' ms';
CreateFood;
Exit;
end;
//Detect food + create Food + create new ball for the snake
if nColor=clGreen then
begin
iLastIndex:=Length(aP);
SetLength(aP,Length(aP)+1);
aP[Length(aP)-1].X:=aP[iLastIndex-1].X;
aP[Length(aP)-1].Y:=aP[iLastIndex-1].Y;
aP[Length(aP)-1].Size:=iSize;
aP[Length(aP)-1].Rad:=aP[i].Size/2;
aP[Length(aP)-1].Color:=clred;
iFoods+=1;
if (iFoods mod nBalls)=0 then
begin
iLevel+=1;
iSpeed:=Timer1.Interval-10;
Timer1.Interval:=iSpeed;
end;
StatusBar1.Panels[0].Text:='Points: ' + inttostr(iFoods);
StatusBar1.Panels[1].Text:='Level: '+ Inttostr(iLevel);
StatusBar1.Panels[2].Text:='Speed: ' + inttostr(iSpeed) + ' ms';
CreateFood;
end;
//Redraw
Form1.Invalidate;
end;
end.
Codigo Fuente + Compilado:[Enlace externo eliminado para invitados]
Saludos