不错不错，以前我也编过，可惜源程序不见了，否则一定交流交流

好象不能用也~~~~

看看这个帖吧：
http://www.programfan.com/club/showbbs.asp?id=100128

真的用不了啊～
整个屏幕灰色，左下角有一点红色，其余什么也没有……

你的蛇把我的电脑搞死了
一运行就全黑了

不好意思,这次发个真确的,这东西我编了5天,我是新手,此程序不当之处请高手多多指教:
uses crt,graph;
var
s,gd,gm,g,p1,p2,i,j,e,x,y:integer;
ss:array[1..5459]of record a1,a2,a3:integer;end;
ch:char;ok:integer;

procedure food(var x,y:integer);
begin
repeat
x:= random(640); until x>1;
repeat
y:= random(480);until y>1;
end;

procedure fen (s:integer);
var q1,q2,q3,q4,q5:integer;
begin
q1:=0;q2:=s;q4:=1;repeat
q2:=q2 div 10;
q1:=q1+1;
until q2=0;
for q3:=1 to q1-1 do
begin
q4:=q4*10;
end;
for q5:=1 to q1 do
begin setcolor(7);
case s div q4 of
1:outtext('1');
2:outtext('2');
3:outtext('3');
4:outtext('4');
5:outtext('5');
6:outtext('6');
7:outtext('7');
8:outtext('8');
9:outtext('9');
0:outtext('0');end;
s:=s mod q4;q4:=q4 div 10;
end;end;

procedure run(i,j:integer;var g:integer);
var p,q,r:integer;
begin
for p:=1 to 5459 do
with ss[p] do
if a1=0
then begin a1:=g;a2:=i;a3:=j;break;end;
g:=g+1;
if ok=2
then begin
for p:=1 to 5459 do begin
with ss[p] do begin
if a1<>0
then begin q:=a1;r:=p;end;end;break;end;
for p:=1 to 5459 do
with ss[p] do
if (a1<>0)and(a1<q)
then begin q:=a1;r:=p;end;
with ss[r] do begin
a1:=0;a2:=0;a3:=0;end;
end; end;

procedure where(e:integer;var p1,p2:integer);
begin
case e of
77:begin p1:=16;p2:=0;end;
75:begin p1:=-16;p2:=0;end;
72:begin p1:=0;p2:=-16;end;
80:begin p1:=0;p2:=16;end;end;end;

procedure pic;
var o:integer;
begin
for o:=1 to 5459 do
with ss[o] do begin
if a1<>0
then begin setcolor(7);circle(a2,a3,8);
end;end;end;

procedure eat(e:integer);
begin
case e of
77:begin
if (((x-i)<=6)and ((abs(y-j)<=11))) then begin ok:=1;run(i,j,g);food(x,y);s:=s+3 end;end;
75:begin
if (((i-x)<=6)and ((abs(y-j)<=11))) then begin ok:=1;run(i,j,g);food(x,y);s:=s+3 end;end;
72:begin
if(((j-y)<=6)and ((abs(x-i)<=11))) then begin ok:=1;run(i,j,g);food(x,y);s:=s+3 end;end;
80:begin
if (((y-j)<=6)and ((abs(x-i)<11))) then begin ok:=1;run(i,j,g);food(x,y);s:=s+3 end;end;end;
end;

procedure head (e,i,j:integer);
begin setcolor(5);
case e of
72:begin
circle(i-2,j-2,1);
circle(i+2,j-2,1);
line(i,j-8,i,j-17);line(i,j-17,i-3,j-20);line(i,j-17,i+3,j-20);end;
80:begin
circle(i-2,j+2,1);
circle(i+2,j+2,1);
line(i,j+8,i,j+17);line(i,j+17,i-3,j+20);line(i,j+17,i+3,j+20);end;
75:begin
circle(i-2,j-2,1);
circle(i-2,j+2,1);
line(i-8,j,i-17,j);line(i-17,j,i-20,j-3);line(i-17,j,i-20,j+3);end;
77 :begin
circle(i+2,j-2,1);
circle(i+2,j+2,1);
line(i+8,j,i+17,j);line(i+17,j,i+20,j-3);line(i+17,j,i+20,j+3);
end;end;end;

procedure over (e,i,j:integer);
var b1:integer;
begin
for b1:=1 to 5459 do
with ss[b1] do
if (a1<>0)and(a1<>(g-1))and(a2=i)and(a3=j)
then begin ClearDevice;outtextxy(300,240,'game over');delay(2000);ch:=#27;end;
if(i>640)or(i<+0)or(j<0)or(j>480)
then begin
ClearDevice;outtextxy(300,240,'game over');delay(2000);ch:=#27;end;
end;

begin  randomize;
gd:=detect;
initgraph(gd,gm,' ');for i:=1 to 5459 do
begin with ss[i] do begin
a1:=0;a2:=0;a3:=0;end;end;
i:=20;j:=20;p1:=16;p2:=0;g:=1;e:=77;
ok:=0;ch:=#255;food(x,y);s:=0;
run(i,j,g);pic;
repeat
i:=i+p1;j:=j+p2;ok:=2;fen(s);
if keypressed
then begin
ch:=readkey;
if ch=#0 then
begin
ch:=readkey;e:=ord(ch);where(e,p1,p2);end;end;
run(i,j,g);pic;delay(50);
over(e,i,j);eat(e);setcolor(3);circle(x,y,4);head(e,i,j);delay(50);
ClearDevice;
until ch=#27;
end.

嗯，不错！
但是那条蛇和蛇的食物闪烁得厉害，我的眼睛受不了。所以不敢多玩几遍。

建议：不要总是ClearDevice，蛇尾用黑色的Circle覆盖掉即可。

还想请问两问题,这程序我在FREE PASCAL中运行,就无法运行,屏幕一直是黑屏,显示器下的灯闪烁不定,这是怎么回事?
另,我想在GAME OVER后再显示一次分数,但我写gotoxy(300,240);时,系统显示常数越界,这又是怎么回事?

Free Pascal的Graph模式不同于TP，是800×600分辩率的，由于刷新率过低，一些显示器不能支持如此低的刷新率（尤其是液晶），我家的显示器也不能支持。所以显示器黑屏了。