unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ExtCtrls;
type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
Timer1: TTimer;
Timer2: TTimer;
MainMenu1: TMainMenu;
file1: TMenuItem;
level1: TMenuItem;
about1: TMenuItem;
help1: TMenuItem;
New1: TMenuItem;
Stop1: TMenuItem;
Away1: TMenuItem;
One1: TMenuItem;
thre1: TMenuItem;
procedure New1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure about1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Timer2Timer(Sender: TObject);
procedure Away1Click(Sender: TObject);
procedure One1Click(Sender: TObject);
procedure ow1Click(Sender: TObject);
procedure thre1Click(Sender: TObject);
procedure help1Click(Sender: TObject);
procedure Stop1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
x,y:array[1..1000]of integer;//Snake
n:integer;
sum:integer;
fx:integer;//director
a,b:integer;
ss1,ss2,ss3,ss4:integer;
length:integer;
fxdeltax:array[1..4] of integer;
fxdeltay:array[1..4] of integer;
round:integer;
implementation
{$R *.dfm}
procedure TForm1.New1Click(Sender: TObject);
var
i:integer;
begin
inc(round);
length:=10;
PaintBox1.Canvas.Pen.Color:=clblack;
PaintBox1.Canvas.Brush.Color:=clgray;
PaintBox1.Canvas.Rectangle(PaintBox1.BoundsRect);
for i:=1 to length do
begin
x[i]:=10+i*10;
y[i]:=260;
PaintBox1.Canvas.Pen.Color:=clsilver;
PaintBox1.Canvas.Brush.Color:=clgreen;
PaintBox1.Canvas.Rectangle(x[i],y[i],x[i]+10,y[i]+10);
end;
Timer1.Enabled:=True;
Timer2.Enabled:=True;
fx:=4;//初始时,方向向右
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
i:integer;
biteself:bool;
begin
sum:=0;
if(fx=4)then//方向向右
begin
PaintBox1.Canvas.Pen.Color:=clsilver;
PaintBox1.Canvas.Brush.Color:=clsilver;
PaintBox1.Canvas.Rectangle(x[1],y[1],x[1]+10,y[1]+10);
for i:=1 to length-1 do
begin
x[i]:=x[i+1];
y[i]:=y[i+1];
end;
x[length]:=x[length]+10;
y[length]:=y[length];
PaintBox1.Canvas.Brush.Color:=clgreen;
PaintBox1.Canvas.Rectangle(x[length],y[length],x[length]+10,y[length]+10);
end;
if(fx=2)then//方向向下
begin
PaintBox1.Canvas.Pen.Color:=clsilver;
PaintBox1.Canvas.Brush.Color:=clsilver;
PaintBox1.Canvas.Rectangle(x[1],y[1],x[1]+10,y[1]+10);
i:=1;
for i:=1 to length-1 do
begin
x[i]:=x[i+1];
y[i]:=y[i+1];
end;
x[length]:=x[length];
y[length]:=y[length]+10;
PaintBox1.Canvas.Brush.Color:=clgreen;
PaintBox1.Canvas.Rectangle(x[length],y[length],x[length]+10,y[length]+10);
end;
if(fx=1)then//方向向上
begin
PaintBox1.Canvas.Pen.Color:=clsilver;
PaintBox1.Canvas.Brush.Color:=clsilver;
PaintBox1.Canvas.Rectangle(x[1],y[1],x[1]+10,y[1]+10);
begin
x[i]:=x[i+1];
y[i]:=y[i+1];
end;
x[length]:=x[length];
y[length]:=y[length]-10;
PaintBox1.Canvas.Brush.Color:=clgreen;
PaintBox1.Canvas.Rectangle(x[length],y[length],x[length]+10,y[length]+10);
end;
if(fx=3)then//方向向左
begin
PaintBox1.Canvas.Pen.Color:=clsilver;
PaintBox1.Canvas.Brush.Color:=clsilver;
PaintBox1.Canvas.Rectangle(x[1],y[1],x[1]+10,y[1]+10);
begin
x[i]:=x[i+1];
y[i]:=y[i+1];
end;
x[length]:=x[length]-10;
y[length]:=y[length];
PaintBox1.Canvas.Brush.Color:=clgreen;
PaintBox1.Canvas.Rectangle(x[length],y[length],x[length]+10,y[length]+10);
end;
if(x[length]<=ss3+10)then
begin
Timer1.Enabled:=False;
Timer2.Enabled:=False;
ShowMessage('Game Over');
end;
if(x[length]>=ss4-10)then
begin
Timer1.Enabled:=False;
Timer2.Enabled:=False;
ShowMessage('Game Over');
end;
if(y[length]<=ss1+10)then
begin
Timer1.Enabled:=False;
Timer2.Enabled:=False;
ShowMessage('Game Over');
end;
if(y[length]>=ss2-10)then
begin
Timer1.Enabled:=False;
Timer2.Enabled:=False;
ShowMessage('Game Over');
end;
if((x[length]=a)and(y[length]=b))then
begin
PaintBox1.Canvas.Brush.Color:=clgreen;
PaintBox1.Canvas.Rectangle(a,b,a+10,b+10);
inc(length);
for i:=length downto 2 do
begin
x[i]:= x[i-1];
y[i]:= y[i-1];
end;
x[1]:=x[1]-fxdeltax[fx];
y[1]:=y[1]-fxdeltax[fx];
Timer2.Enabled:=true;
end;
biteself:=False;
for i:=1 to length-1 do
begin
if(x[length]=x[i])and(y[length]=y[i])then
begin
biteself:=True;
break;
end;
end;
if(biteself)then
begin
Timer1.Enabled:=False;
Timer2.Enabled:=False;
ShowMessage('Game Over');
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i:integer;
begin
random(PaintBox1.Width-20);
random(PaintBox1.Height-20);
round:=0;
fxdeltax[1]:=0;
fxdeltax[2]:=0;
fxdeltax[3]:=-10;
fxdeltax[4]:=10;
fxdeltay[1]:=-10;
fxdeltay[2]:=10;
fxdeltay[3]:=0;
fxdeltay[4]:=0;
ss1:=PaintBox1.Top;
ss2:=PaintBox1.Height+ss1;
ss3:=PaintBox1.Left;
ss4:=PaintBox1.Width+ss3;
n:=0;
PaintBox1.Canvas.Pen.Color:=clblack;
PaintBox1.Canvas.Brush.Color:=clgray;
PaintBox1.Canvas.Rectangle(PaintBox1.BoundsRect);
for i:=1 to length do
begin
x[i]:=10+i*10;
y[i]:=PaintBox1.height div +Paintbox1.Top;
end;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
//VK_LEFT=37;
//VK_UP=38;
//VK_RIGHT=39;
//VK_DOWN=40;
if((key=37)and(fx<>4))then
fx:=3;
if((key=38)and(fx<>2))then
fx:=1;
if((key=39)and(fx<>3))then
fx:=4;
if((key=40)and(fx<>1))then
fx:=2;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
var
i,ta,tb:integer;
overlap:bool;
begin
overlap:=True;
repeat
begin
ta:=random(PaintBox1.Width-40);
//tb:=random(PaintBox1.Height-40);
a:=20+(ta div 10)*10;
b:=20+(ta div 10)*10;
for i:=1 to length do
begin
if not((a=x[i])and(b=y[i]))then
begin
overlap:=False;
break;
end;
end;
end;
until(not overlap);
PaintBox1.Canvas.Brush.Color:=clYellow;
PaintBox1.Canvas.Rectangle(a,b,a+10,b+10);
Timer2.Enabled:=False;
end;
procedure TForm1.Stop1Click(Sender: TObject);
begin
if n=0 then
begin
Stop1.Caption:='Continue';
Timer1.Enabled:=False;
n:=1;
end
else
begin
Stop1.Caption:='Stop';
Timer1.Enabled:=True;
n:=0;
end;
end;
procedure TForm1.Away1Click(Sender: TObject);
begin
close();
end;
procedure TForm1.One1Click(Sender: TObject);
begin
Timer1.Interval:=250;
end;
procedure TForm1.Tow1Click(Sender: TObject);
begin
Timer1.Interval:=150;
end;
procedure TForm1.thre1Click(Sender: TObject);
begin
Timer1.Interval:=75;
end;
procedure TForm1.about1Click(Sender: TObject);
begin
ShowMessage('Happy Snake');
end;
procedure TForm1.help1Click(Sender: TObject);
begin
ShowMessage('方向键控制小蛇移动,小蛇不能撞墙,也不能碰到自己的身体。');
end;
end.