interface

 

uses

а Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

а Dialogs, ImgList, StdCtrls, ExtCtrls, Menus;

 

type

 

а TForm1 = class(TForm)

ааа screen: TImage;

ааа Label1: TLabel;

ааа ImageList: TImageList;

ааа MainMenu1: TMainMenu;

ааа new1: TMenuItem;

ааа procedure FormKeyDown(Sender: TObject; var Key: Word;

ааааа Shift: TShiftState);

 

 

ааа procedure new1Click(Sender: TObject);

а private

ааа { Private declarations }

а public

ааа { Public declarations }

а end;

 

const

а fieldheight=30;

а fieldwidth=40;

var

а Form1: TForm1;

а msecsperframe:integer=10;

а snake:array[1..fieldheight*fieldwidth] of tpoint;

а snakelength:integer;

а dx,dy:integer;

а background,body,head,tail:tbitmap;

а firstrun:boolean=true;

а number:tpoint;

а curnumber:integer;

а och:integer;

implementation

 

{$R *.dfm}

procedure loadbitmaps;

begin

аbackground :=tbitmap.create;

аbody:=tbitmap.create;

аhead:=tbitmap.create;

аtail:=tbitmap.create;

аform1.imagelist.getbitmap(9, tail);

аform1.imagelist.getbitmap(10, body);

аform1.imagelist.getbitmap(11, head);

аform1.imagelist.getbitmap(12, background);

end;

procedure freebitmaps;

begin

а background.free;

а head.free;

а tail.free;

а body.free;

end;

 

procedure initsnake;

begin

аsnakelength:=3;

аsnake[1].x:=0; snake[2].x:=1;snake[2].x:=2;

аsnake[1].y:=0; snake[2].y:=0;snake[3].y:=0;

end;

function issnake(x,y:integer):boolean;

var i:integer;

begin

а issnake:=false;

а for i:=1 to snakelength do

а if (snake[i].x=x) and (snake[i].y=y) then issnake:=true;

end;

procedure placenumber;

var temp:tbitmap;

begin

а temp:=tbitmap.Create;

а repeat

а number.x:=random(fieldwidth);

а number.y:=random(fieldheight);

а until not issnake(number.x,number.y);

а curnumber:= 1+random(9);

а form1.imagelist.getbitmap(curnumber-1,temp);

а form1.screen.canvas.draw(16*number.x,16*number.y,temp);

а temp.Free;

end;

 

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;

а Shift: TShiftState);

begin

а case key of

ааа {vk_back:p:=not p;}

ааа vk_left: if dx=0 then begin dx:=-1; dy:=0 end;

ааа vk_right: if dx=0 then begin dx:=1; dy:=0 end;

ааа vk_up: if dy=0 then begin dx:=0; dy:=-1 end;

ааа vk_down: if dy=0 then begin dx:=0; dy:=1 end;

а end;

end;

procedure clearfield;

begin

а form1.screen.Canvas.Rectangle(0,0,640,480);

end;

 

procedure TForm1.new1Click(Sender: TObject);

var oldtime:tdatetime;

ааа newx,newy:integer;

ааа togrow:integer;

begin

а if not firstrun then exit;

а firstrun:=false;

а randomize;

а loadbitmaps;

а while id_cancel<>application.MessageBox('ok-run cancel-exit','',mb_okcancel)

а do

а begin

ааа dx:=0;

ааа dy:=1;

ааа clearfield;

ааа initsnake;

ааа placenumber;

ааа togrow:=0;

ааа while true do

ааа begin

ааааа oldtime:=now;

ааааа newx:=snake[snakelength].x+dx;

ааааа newy:=snake[snakelength].y+dy;

ааааа if (newx<0 )or (newx>=fieldwidth) orа (newy<0) or (newy>=fieldheight) orа issnake(newx,newy)

ааааа then break;

ааааа if (newx=number.x)and(newy=number.y) then

ааааа begin

ааааааа togrow:=togrow+curnumber;

ааааааа placenumber;

ааааа end;

ааааа if togrow>0 then

ааааа begin

ааааааа togrow:=togrow-1а ;

ааааааа snakelength:=snakelength+1;

ааааа end;

ааааа snake[snakelength+1].x:=newx;

ааааа snake[snakelength+1].y:=newy;

ааааа form1.screen.Canvas.Draw(16*snake[1].x,16*snaKE[1].y,background);

ааааа form1.screen.Canvas.Draw(16*snake[2].x,16*snaKE[2].y,tail);

ааааа move(snake[2],snake[1],sizeof(tpoint)*snakelength);

ааааа form1.screen.Canvas.Draw(16*snake[snakelength-1].x,16*snaKE[snakelength-1].y,body);

ааааа form1.screen.Canvas.Draw(16*snake[snakelength].x,16*snaKE[snakelength].y,head);

ааааа och:=snakelength*100 div msecsperframe;

ааааа form1.Label1.Caption:=inttostr(och);

ааааа application.ProcessMessages;

ааааа while round(msecsperframe-(now-oldtime)*msecsperday)>0 do

ааааа application.ProcessMessages;

ааа end;

а end;

а freebitmaps;

а application.Terminate;

end;

 

 

end.