下午写了一个贪食蛇游戏，贴出源码（有详细注释）给大家，欢迎讨论…(200分)

窗体代码：
object MainForm: TMainForm
Left = 235
Top = 198
Width = 447
Height = 232
ActiveControl = BtnReload
BorderIcons = [biSystemMenu, biMinimize]
Caption = 'Snake 1.0 [ 2002.7.4 By Blank ]'
Color = clBtnFace
Constraints.MaxHeight = 232
Constraints.MaxWidth = 447
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '宋体'
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
OnCreate = FormCreate
OnKeyDown = FormKeyDown
PixelsPerInch = 96
TextHeight = 12
object Shape1: TShape
Left = 7
Top = 7
Width = 343
Height = 190
Brush.Style = bsClear
end
object Label1: TLabel
Left = 361
Top = 76
Width = 30
Height = 12
Caption = '速度:'
end
object SG: TStringGrid
Left = 8
Top = 8
Width = 340
Height = 188
BorderStyle = bsNone
ColCount = 20
DefaultColWidth = 16
DefaultRowHeight = 16
DefaultDrawing = False
Enabled = False
FixedCols = 0
RowCount = 11
FixedRows = 0
Options = [goFixedVertLine, goFixedHorzLine]
TabOrder = 0
OnDrawCell = SGDrawCell
end
object BtnPause: TBitBtn
Left = 360
Top = 40
Width = 75
Height = 25
Caption = '暂停'
TabOrder = 1
OnClick = BtnPauseClick
end
object BtnReload: TBitBtn
Left = 360
Top = 8
Width = 75
Height = 25
Caption = '开始'
TabOrder = 2
OnClick = BtnReloadClick
end
object ComSpeed: TComboBox
Left = 394
Top = 72
Width = 41
Height = 20
Style = csDropDownList
DropDownCount = 9
ItemHeight = 12
TabOrder = 3
OnChange = ComSpeedChange
Items.Strings = (
'1'
'2'
'3'
'4'
'5'
'6'
'7'
'8'
'9')
end
object Memo1: TMemo
Left = 360
Top = 131
Width = 73
Height = 65
BorderStyle = bsNone
Color = clInactiveBorder
Lines.Strings = (
'箭头: 控制'
''
'回车: 开始'
' 暂停')
ReadOnly = True
TabOrder = 4
end
object Timer1: TTimer
Enabled = False
Interval = 500
OnTimer = Timer1Timer
Left = 152
Top = 72
end
end

单元代码：
unit SnakeFrm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Grids, ExtCtrls, Buttons;

type
TMainForm = class(TForm)
SG: TStringGrid;
Timer1: TTimer;
Shape1: TShape;
Label1: TLabel;
BtnPause: TBitBtn;
BtnReload: TBitBtn;
ComSpeed: TComboBox;
Memo1: TMemo;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure SGDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
State: TGridDrawState);
procedure BtnReloadClick(Sender: TObject);
procedure BtnPauseClick(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure ComSpeedChange(Sender: TObject);
private
{ ToDo: Main: ### Private }
procedure InitSnake;
procedure StartSnake;
procedure StopSnake;
procedure DoGameOver;
procedure ClearOld;
procedure DrawNew;
procedure GetNew;
procedure SetRandomPoint;
public
{ Public declarations }
end;

var
MainForm: TMainForm;

implementation

{$R *.DFM}

type
TDirectionType = (dtLeft, dtRight, dtUp, dtDown);

type
TSigle = Record { 蛇(Snake)由 n 个 Sigle 组成 }
Dt: TDirectionType; { Direction }
Ps: TPoint; { Position }
end;

const
InitPosX = 8; { 初始位置、长度和方向 }
InitPosY = 5;
InitLeng = 6;
InitDir = dtRight;

var
Snake: array of TSigle; { 蛇体 }
Tail: TSigle; { 蛇尾 }
GameOver: Boolean; { 结束标志 }
Food: TPoint; { 食物坐标 }

{ 游戏结束 }
procedure TMainForm.DoGameOver;
begin
GameOver := True;
StopSnake;
end;

{ ToDo: Main: GetNew }
{ 获取蛇的下一个位置 }
procedure TMainForm.GetNew;
var
I: Integer;
begin
{ 如果蛇已越界，结束 }
if (Snake[0].Ps.X < 0) or (Snake[0].Ps.X >= Sg.ColCount) or
(Snake[0].Ps.Y < 0) or (Snake[0].Ps.Y >= Sg.RowCount) then
begin
DoGameOver;
Exit;
end;

{ 蛇尾 }
Tail := Snake[High(Snake)];

{ 如果吃到了食物 }
if (Snake[0].Ps.X = Food.X) and (Snake[0].Ps.Y = Food.Y) then
begin
SetLength(Snake, High(Snake) + 2);
case Tail.Dt of
dtLeft: Inc(Tail.Ps.X);
dtRight: Dec(Tail.Ps.X);
dtUp: Inc(Tail.Ps.Y);
dtDown: Dec(Tail.Ps.Y);
end;
SetRandomPoint;
end;

{ 蛇体新的位置 }
for I := High(Snake) downto 1 do
Snake := Snake[I - 1];

{ 蛇头的位置 }
case Snake[0].Dt of
dtLeft: Dec(Snake[0].Ps.X);
dtRight: Inc(Snake[0].Ps.X);
dtUp: Dec(Snake[0].Ps.Y);
dtDown: Inc(Snake[0].Ps.Y);
end;

{ 如果撞到了自己的身体 }
for I := 1 to High(Snake) do
if (Snake[0].Ps.X = Snake.Ps.X) and (Snake[0].Ps.Y = Snake.Ps.Y) then
DoGameOver;
end;

{ ToDo: Main: DrawNew }
procedure TMainForm.DrawNew;
begin
{ 画出蛇体 }
with Sg.Canvas do
begin
Brush.Color := clWhite;
Brush.Style := bsSolid;
FillRect(SG.CellRect(Tail.Ps.X, Tail.Ps.Y));
Brush.Color := clNavy;
FillRect(SG.CellRect(Snake[0].Ps.X, Snake[0].Ps.Y));
end;
end;

{ ToDo: Main: Timer }
procedure TMainForm.Timer1Timer(Sender: TObject);
begin
GetNew;
DrawNew;
end;

{ ToDo: Main: ### Create }
procedure TMainForm.FormCreate(Sender: TObject);
begin
ComSpeed.ItemIndex := 8; { 速度 }
InitSnake;
GameOver := True;
Food := Point(-1, -1);
end;

procedure TMainForm.SGDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
I: Integer;
begin
{ 窗体重画 }
for I := 0 to High(Snake) do
if (ACol = Snake.Ps.X) and (ARow = Snake.Ps.Y) then
with Sg.Canvas do
begin
Brush.Color := clNavy;
Brush.Style := bsSolid;
FillRect(Rect);
Break;
end;
if (ACol = Food.X) and (ARow = Food.Y) then
Sg.Canvas.Ellipse(Rect);
end;

{ TODO : Main: StartSnake }
{ 继续 }
procedure TMainForm.StartSnake;
begin
ActiveControl := nil;
GameOver := False;
Timer1.Enabled := True;
SetRandomPoint;
end;

{ TODO : Main: SetRandomPoint }
{ 随机出现食物 }
procedure TMainForm.SetRandomPoint;
var
P: TPoint;
I: Integer;
IsExist: Boolean;
begin
Randomize;
IsExist := True;
while IsExist do
begin
IsExist := False;
P.X := Random(Sg.ColCount);
P.Y := Random(Sg.RowCount);
for I := 0 to High(Snake) do
if (P.X = Snake.Ps.X) and (P.Y = Snake.Ps.Y) then
begin
IsExist := True;
Break;
end;
end;

{ 画出食物 }
Food := P;
Sg.Canvas.Brush.Color := clNavy;
Sg.Canvas.Brush.Style := bsSolid;
Sg.Canvas.Ellipse(SG.CellRect(Food.X, Food.Y));
end;

{ TODO : Main: StopSnake }
procedure TMainForm.StopSnake;
begin
Timer1.Enabled := False;
end;

{ 重新开始 }
procedure TMainForm.BtnReloadClick(Sender: TObject);
begin
ClearOld;
InitSnake;
StartSnake;
end;

{ TODO : Main: ClearOld }
{ 清除旧图像 }
procedure TMainForm.ClearOld;
var
I: Integer;
begin
Sg.Canvas.Brush.Color := clWhite;
Sg.Canvas.Brush.Style := bsSolid;
for I := 0 to High(Snake) do
Sg.Canvas.FillRect(SG.CellRect(Snake.Ps.X, Snake.Ps.Y));
Sg.Canvas.FillRect(SG.CellRect(Food.X, Food.Y));
end;

{ TODO : Main: InitSnake }
{ 初始化蛇体 }
procedure TMainForm.InitSnake;
var
I: Integer;
begin
Sg.Canvas.Brush.Color := clNavy;
SetLength(Snake, InitLeng);
for I := 0 to InitLeng - 1 do
begin
Snake.Dt := dtRight;
Snake.Ps.X := InitPosX - I;
Snake.Ps.Y := InitPosY;
Sg.Canvas.FillRect(SG.CellRect(Snake.Ps.X, Snake.Ps.Y));
end;
Timer1.Interval := 1000 - StrToInt(ComSpeed.Text) * 100;
end;

procedure TMainForm.BtnPauseClick(Sender: TObject);
begin
StopSnake;
end;

{ 控制蛇体 }
procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
case Key of
VK_Left:
if (Snake[0].Dt <> dtLeft) and (Snake[0].Dt <> dtRight) and (Snake[1].Dt <> dtRight) then
Snake[0].Dt := dtLeft;

VK_Right:
if (Snake[0].Dt <> dtLeft) and (Snake[0].Dt <> dtRight) and (Snake[1].Dt <> dtLeft) then
Snake[0].Dt := dtRight;

VK_Up:
if (Snake[0].Dt <> dtUp) and (Snake[0].Dt <> dtDown) and (Snake[1].Dt <> dtDown) then
Snake[0].Dt := dtUp;

VK_Down:
if (Snake[0].Dt <> dtUp) and (Snake[0].Dt <> dtDown) and (Snake[1].Dt <> dtUp) then
Snake[0].Dt := dtDown;

VK_Return: if GameOver then BtnReloadClick(Self) else Timer1.Enabled := not Timer1.Enabled;
end;
end;

{ 设置速度 }
procedure TMainForm.ComSpeedChange(Sender: TObject);
begin
Timer1.Interval := 1000 - StrToInt(ComSpeed.Text) * 100;
end;

end.

好长啊！我copy了慢慢看！谢谢啊！（有的学，还有分赚）

唉!!!
好人啊!!我会好好研究!!!谢了！！！

谢谢，好人呐！收藏

诺基亚手机游戏---贪吃蛇源程序 共 1 篇 第 1-1 屏

作者： 疾风之猫[7315391] 2001-01-25 15:36:52
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Buttons, ComCtrls;

type
TForm1 = class(TForm)
Timer1: TTimer;
GroupBox1: TGroupBox;
PaintBox1: TPaintBox;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
SpeedButton5: TSpeedButton;
SpeedButton6: TSpeedButton;
Label1: TLabel;
Label2: TLabel;
SpeedButton7: TSpeedButton;
UpDown1: TUpDown;
Edit1: TEdit;
Label5: TLabel;
SpeedButton8: TSpeedButton;
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
procedure SpeedButton6Click(Sender: TObject);
procedure SpeedButton7Click(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure SpeedButton8Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
x,y,xxx,yyy:array[1..100] of integer;
fx:word;
sx,sy,ss:integer;
implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
begin
PaintBox1.Canvas.Brush.Color:=clblue;

for i:=10 downto 1 do
begin
x:=10+i*10;
y:=197;
PaintBox1.Canvas.Rectangle(x,y,x+10,y+10);
end;
fx:=3;
timer1.Enabled:=true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
i:integer;
t:string;
begin
Randomize;
PaintBox1.Canvas.pen.Color:=clsilver;
PaintBox1.Canvas.Brush.Color:=clsilver;
PaintBox1.Canvas.Rectangle(x[1],y[1],x[1]+10,y[1]+10);
PaintBox1.Canvas.Brush.Color:=clblue;
for i:=1 to ss-1 do
begin
x:=x[i+1];
y:=y[i+1];
end;
//判断左右上下的情况
if fx=1 then
x[ss]:=x[ss]-10;
if fx=2 then
y[ss]:=y[ss]-10;
if fx=3 then
x[ss]:=x[ss]+10;
if fx=4 then
y[ss]:=y[ss]+10;
//如果蛇头碰到了四边
PaintBox1.Canvas.Pen.Color :=clblack;
PaintBox1.Canvas.Rectangle(sx,sy,sx+10,sy+10);
if (x[ss]>PaintBox1.Width-10) or (x[ss]<0) or (y[ss]<0) or (y[ss]>PaintBox1.Height)then
begin
timer1.Enabled:=false;
UpDown1.Enabled:=true;
edit1.Enabled:=true;
application.MessageBox('你输了!','贪吃蛇',MB_OK);
label2.Caption:='0';
PaintBox1.Canvas.pen.Color:=clsilver;
PaintBox1.Canvas.Brush.Color:=clsilver;
PaintBox1.Canvas.Rectangle(0,0,PaintBox1.Width,PaintBox1.Height);
end;
//如果蛇头碰到了蛇的身体
for i:=1 to ss-1 do
begin
if (x[ss]=x) and (y[ss]=y) then
begin
timer1.Enabled:=false;
UpDown1.Enabled:=true;
edit1.Enabled:=true;
application.MessageBox('你输了!','游戏结束',MB_OK);
label2.Caption:='0';
PaintBox1.Canvas.pen.Color:=clsilver;
PaintBox1.Canvas.Brush.Color:=clsilver;
PaintBox1.Canvas.Rectangle(0,0,PaintBox1.Width,PaintBox1.Height);
end;
end;
//如果蛇吃到了事物
if (x[ss]=sx) and (y[ss]=sy) then
begin
//计算得分
label2.caption:=inttostr(strtoint(label2.caption)+strtoint(edit1.text));
PaintBox1.Canvas.Pen.Color :=clblack;
PaintBox1.Canvas.Brush.Color:=clblue;
sx:=random(19)*10;
sy:=random(11)*10;
for i:=1 to ss do
begin
if (x=sx) and (y=sy) then
begin
sx:=random(19)*10;sy:=random(11)*10;
PaintBox1.Canvas.Rectangle(sx,sy,sx+10,sy+10);
end;
end;
if (x<>sx) and (y<>sy) then
begin
PaintBox1.Canvas.Rectangle(sx,sy,sx+10,sy+10);
ss:=ss+1;
x[ss]:=x[ss-1];
y[ss]:=y[ss-1];
exit;
end;
end;
//画蛇身

for i:=1 to ss do
begin
PaintBox1.Canvas.Pen.Color :=clsilver;
PaintBox1.Canvas.Rectangle(x,y,x+10,y+10);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
i:integer;
begin
PaintBox1.Canvas.Brush.Color:=clsilver;
PaintBox1.Canvas.Rectangle(x[1],y[1],x[1]+10,y[1]+10);
PaintBox1.Canvas.Brush.Color:=clblue;
for i:=1 to 9 do
begin
x:=x[i+1];
y:=y[i+1];
end;
x[10]:=x[10]+10;
for i:=1 to 10 do
PaintBox1.Canvas.Rectangle(x,y,x+10,y+10);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (key=37) and (fx<>3) then
fx:=1;
if (key=38) and (fx<>4) then
fx:=2;
if (key=39) and (fx<>1) then
fx:=3;
if (key=40) and (fx<>2) then
fx:=4;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if fx<>4 then
fx:=2;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
if fx<>3 then
fx:=1;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
{PaintBox1.Canvas.Brush.Color:=clsilver;
PaintBox1.Canvas.Rectangle(x[1],y[1],x[1]+10,y[1]+10);
PaintBox1.Canvas.Brush.Color:=clblue;
for i:=1 to 9 do
begin
x:=x[i+1];
y:=y[i+1];
end;
y[10]:=y[10]+10;
for i:=1 to 10 do
PaintBox1.Canvas.Rectangle(x,y,x+10,y+10);}
if fx<>2 then
fx:=4
end;
procedure TForm1.SpeedButton4Click(Sender: TObject);

begin
if fx<>1 then
fx:=3;
end;
procedure TForm1.SpeedButton5Click(Sender: TObject);
var
i:integer;
begin
UpDown1.Enabled:=false;
edit1.Enabled:=false;
form1.SetFocus;
PaintBox1.Canvas.Pen.Color :=clblack;
PaintBox1.Canvas.Brush.Color:=clblue;
sx:=100;sy:=60;
PaintBox1.Canvas.Rectangle(sx,sy,sx+10,sy+10);
PaintBox1.Canvas.Pen.Color :=clsilver;
PaintBox1.Canvas.Brush.Color:=clblue;
ss:=10;
for i:=ss downto 1 do
begin
x:=10+i*10;
y:=PaintBox1.Height-10;
PaintBox1.Canvas.Rectangle(x,y,x+10,y+10);
end;
fx:=3;
timer1.Interval:=1000-(strtoint(edit1.text)*100);
timer1.Enabled:=true;
end;

procedure TForm1.SpeedButton6Click(Sender: TObject);
begin
if speedbutton6.Caption='暂停' then
begin
Timer1.Enabled:=false;
UpDown1.Enabled:=true;
edit1.Enabled:=true;
speedbutton6.Caption:='继续'
end
else
begin
Timer1.Enabled:=true;
UpDown1.Enabled:=false;
edit1.Enabled:=false;
speedbutton6.Caption:='暂停'
end;
end;

procedure TForm1.SpeedButton7Click(Sender: TObject);
begin
timer1.Enabled:=false;
UpDown1.Enabled:=true;
edit1.Enabled:=true;
PaintBox1.Canvas.pen.Color:=clsilver;
PaintBox1.Canvas.Brush.Color:=clsilver;
PaintBox1.Canvas.Rectangle(0,0,290,210);
label2.Caption:='0';
application.MessageBox('游戏结束!','贪吃蛇',MB_OK);
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
i:integer;
begin
PaintBox1.Canvas.Pen.Color :=clblack;
PaintBox1.Canvas.Brush.Color:=clblue;
PaintBox1.Canvas.Rectangle(sx,sy,sx+10,sy+10);
PaintBox1.Canvas.Pen.Color :=clsilver;
PaintBox1.Canvas.Brush.Color:=clblue;
for i:=1 to ss do
PaintBox1.Canvas.Rectangle(x,y,x+10,y+10);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
sx:=100;sy:=60;
end;

procedure TForm1.SpeedButton8Click(Sender: TObject);
begin
application.MessageBox('贪吃蛇是一个手机上比较常见的游戏'+chr(13)+chr(10)+chr(13)+chr(10)+'疾风之猫完成于农历蛇年大年三十晚','关于',MB_OK);
end;

end.

好啊，收藏。

顶层的老兄们，打个包吧，太麻烦了。

呵呵，收藏起来

收藏中。。。。
对不起，您的收藏夹已满，不能执行这样的操作
我倒！~ ^_^

好，收藏！

疾风之猫： 能不能把窗体代码贴出来？
bigroute：打了包没地方放＊_＊

收藏！

to 叶不归:
昨晚一点多我在试你的"贪吃蛇"时突然发现一个BUG，偶尔才会出现，就是食物有时候会
不见了，本来蛇吃完一个食物后会在别的地方再出现一个食物，可是有时候去不会出现，因
为昨晚太迟了我也没去看程序，今天还没空去看，先来这里告诉你，请检查一下。

用我的那段代码吧，没有BUG的，很好使，还有记分！

我也碰到出错了，除了楼上说的，还有都是整个屏幕有一半都黑了

to 疾风之猫：老大，你要贴也把dfm也贴上来呀，这个搞很累的

暂时没细看

多人接受答案了。