interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, Menus, StdCtrls;
type block=record
x:byte;
y:byte;
end;
type sequence=array[1..60]of block;
const right=1;
down=2;
lef=3;
up=4;
type
TForm1 = class(TForm)
Image1: TImage;
PopupMenu1: TPopupMenu;
start: TMenuItem;
exit: TMenuItem;
Timer1: TTimer;
Label1: TLabel;
about1: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
procedure FormShow(Sender: TObject);
procedure exitClick(Sender: TObject);
procedure startClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure about1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N6Click(Sender: TObject);
private
line:sequence;
len:byte;
direction:byte;
ball:block;
procedure draw(x,y:byte);
procedure remove(x,y:byte);
procedure ballgenerate(var ball:block;line:sequence;len:byte);
function check(line:sequence;len:byte):boolean;//检测队列是否形成环路，true为真
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses about;
{$R *.DFM}
function tform1.check(line:sequence;len:byte):boolean;//检测队列是否形成环路，true为真
var i:byte;
begin
check:=false;
for i:=2 to len do
begin
if (line[1].x=line.x) and (line[1].y=line.y) then
check:=true;
end;
end;
procedure tform1.ballgenerate(var ball:block;line:sequence;len:byte);
var x,y,i:integer;
flag:boolean;//判断产生的球是否与长列重合，false为重合
begin
randomize;
flag:=false;
while flag=false do
begin
flag:=true;
x:=random(20)+1;
y:=random(20)+1;
for i:=1 to len do
begin
if (line.x=x) and (line.y=y) then
flag:=false;
end;
end;
ball.x:=x;
ball.y:=y;
image1.Canvas.brush.Color:=clblue;
image1.Canvas.pen.Color:=clblack;
image1.canvas.rectangle(x*20-20,y*20-20,x*20,y*20);
image1.canvas.floodfill(x*20-15,y*20-15,clblack,fssurface);
end;
procedure tform1.remove(x,y:byte);
begin
image1.Canvas.brush.Color:=clblack;
image1.Canvas.pen.Color:=clblack;
image1.canvas.rectangle(x*20-20,y*20-20,x*20,y*20);
image1.canvas.floodfill(x*20-15,y*20-15,clwhite,fssurface);
end;
procedure tform1.draw(x,y:byte);
begin
image1.Canvas.brush.Color:=clgreen;
image1.Canvas.pen.Color:= clLime;
image1.canvas.rectangle(x*20-20,y*20-20,x*20,y*20);
image1.canvas.floodfill(x*20-15,y*20-15,cllime,fssurface);
end;
procedure TForm1.FormShow(Sender: TObject);
var bg:trect;
begin
bg:=rect(0,0,image1.width,image1.height);
image1.canvas.brush.color:=clblack;
image1.canvas.fillrect(bg);
end;
procedure TForm1.exitClick(Sender: TObject);
begin
close;
end;
procedure TForm1.startClick(Sender: TObject);
var i:byte;
bg:trect;
begin
bg:=rect(0,0,image1.width,image1.height);
image1.canvas.brush.color:=clblack;
image1.canvas.fillrect(bg);
len:=4;
for i:=1 to len do
begin
line.x:=len-i+1;
line.y:=10;
end;
for i:=1 to len do
draw(line.x,line.y);
ballgenerate(ball,line,len);
timer1.Enabled:=true;
direction:=right;
label1.Visible:=false;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var i,endx,endy,headx,heady:byte;
flag:boolean;
begin
flag:=false;
headx:=line[1].x;
heady:=line[1].y;
case direction of
right:line[1].x:=line[1].x+1;
down: line[1].y:=line[1].y+1;
lef: line[1].x:=line[1].x-1;
up: line[1].y:=line[1].y-1;
end;
if (line[1].x<1) or (line[1].x>20) or (line[1].y<1) or (line[1].y>20) then
begin
timer1.Enabled:=false;
label1.Visible:=true;
end;
if (line[1].x=ball.x) and (line[1].y=ball.y) then
begin
len:=len+1;
flag:=true;
end;
endx:=line[len].x;
endy:=line[len].y;
for i:=len downto 3 do
begin
line.x:=line[i-1].x;
line.y:=line[i-1].y;
end;
line[2].x:=headx;
line[2].y:=heady;
if check(line,len) then
begin
timer1.Enabled:=false;
label1.Visible:=true;
end;
if flag=true then
ballgenerate(ball,line,len)
else
remove(endx,endy);
draw(line[1].x,line[1].y);
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case key of
37:if direction<>right then direction:=lef;
38:if direction<>down then direction:=up;
39:if direction<>left then direction:=right;
40:if direction<>up then direction:=down;
end;
end;
procedure TForm1.about1Click(Sender: TObject);
begin
timer1.Enabled:=false;
form2.showmodal;
end;
procedure TForm1.N2Click(Sender: TObject);
begin
timer1.Interval:=800;
end;
procedure TForm1.N3Click(Sender: TObject);
begin
timer1.Interval:=500;
end;
procedure TForm1.N4Click(Sender: TObject);
begin
timer1.Interval:=300;
end;
procedure TForm1.N5Click(Sender: TObject);
begin
timer1.Interval:=100;
end;
procedure TForm1.N6Click(Sender: TObject);
begin
timer1.Enabled:=not timer1.Enabled;
end;
end.
就用一个iamge控件就可以，你看看吧。
