VB 贪吃蛇 单人版游戏
作者： 来源： 添加时间：2006-5-21 20:47:29设计思路：
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
（一）开始新游戏
1.1 获取并应用各个参数（当前级别，控制键等），初始化随机数（Randomize）。
1.2 清除地图上的所有物品，各个统计数值置零。
1.3 初始化地图：布置食物，炸弹，蛇身位置以及蛇头的移动方向——在PictureBox上绘画图像 并修改对应的地图格属性值（MapProperty()数组）。
1.4 启动Timer定时器，游戏开始。
（二）游戏操作
2.1 暂停\恢复——
修改表示游戏状态的Boolean型变量值；
显示\隐藏 表示游戏状态的Label；
暂停\恢复 Timer定时器。
2.2 控制方向（根据Nokia贪吃蛇的操作方式）——
由于蛇头只能朝上下左右4个方向移动，但是方向键有8个，所以“斜线方向”的控制键和水平，垂直方向的控制键编码上有点不同
2.2.1 斜线方向键（以“右上”方向键为例）——
如果当前蛇头朝着左边（水平方向）运动，则将水平方向的分量变为0，再将垂直方向的分量变为-1（向上运动）；
如果当前蛇头朝着上方（垂直方向）运动，则将垂直方向的分量变为0，再将水平方向的分量变为 1（向右运动）。
其余“左上，左下，右下”的方向键编码与上述雷同。
2.2.2“水平，垂直”方向键——
当蛇以 水平 方向移动时，“左”和“右”的按键无效；（即不处理按键事件）
当蛇以 垂直 方向移动时，“上”和“下”的按键无效。
（三）移动蛇身
3.1 根据运动方向，找出蛇头的新坐标；
3.2 判断蛇头新坐标下的 地图属性——
（1）如果蛇头的新坐标 和当前 蛇尾 的坐标重合，那不算GameOver－－因为随着蛇头的移动，蛇身各个节点都会向前跟进，使得当前 蛇尾 坐标下的网格在移动之后会变成 空白地。
（2）如果当前蛇头位置的地图属性是“食物”——增加蛇身长度，统计玩家吃进的食物数量，增加分数，补充地图上的食物，记录（累加）当前吃进的物品，如果吃进的物品（curEatCount） 达到一定数量（EatCountPerShowPrize）就在地图上显示奖品。
（3）如果当前蛇头位置的地图属性是“炸弹“（陷阱）——统计玩家吃进的炸弹数量，扣分（如果分数小于0，就GameOver），补充地图上的炸弹，记录（累加）当前吃进的物品，如果吃进的物品达到一定数量就显示奖品。
（4）如果当前蛇头位置的地图属性是“奖品”——加分，重新累计 吃进的物品数（curEatCount = 0）
3.3 刷新蛇身坐标，更新 地图网格属性 以及画面
（1）在更新蛇身坐标之前，保存原来的 蛇尾坐标；
（2）先在地图上 擦除旧的的蛇头，然后在地图上 绘画出新的蛇头；
（3）修改变量值，标记蛇头新坐标下的地图格属性为：蛇身；
（4）要先更新 蛇身除了蛇头外其余部分的坐标；
（5）之后才更新 蛇头的坐标；
（6）判断是否需要 增加蛇身长度——如果要增加长度：旧蛇尾的坐标不变，蛇身长度 + 1；
否则（无需增加蛇身长度）：如果蛇头的新坐标与旧蛇尾的坐标重合，就不用在旧蛇尾的坐标下 绘画空白地的图案（因为该网格属性已经是 蛇头，而不是空白地）
（7）在地图上擦除旧蛇尾，绘画空白地；
（8）在地图上把 旧蛇尾坐标 下的地图格的属性设置为 空白地；
《标准模块 Module1 代码》——
Option Explicit
'******************************************************************************************************************************
'全局 常量
Public Enum MAP_PROPERTY '地图属性
MAP_EMPTY = 0 '空白地
MAP_FOOD '食物
MAP_BOMB '炸弹，陷阱
MAP_PRIZE '加分奖品
MAP_SNAKE '蛇身
End Enum
Public Const MAP_SCALE As Integer = 15 '地图放大倍数
'地图网格数（Index值，首值为0）
Public Const MAX_COL_INDEX As Integer = 19
Public Const MAX_ROW_INDEX As Integer = 10
Public Const START_SNAKE_LENGTH As Integer = 8 '蛇身初始长度
Public Const SPEED_LV1 As Integer = 200 '第一级（最慢）的速度（Timer.Interval，最快第9级＝40）
Public Const SPEED_CHANGE As Integer = 20 '前后2个等级之间的 Interval差值（毫秒）
'定义控制键
Public Const KEY_PAUSE As Integer = vbKeyNumpad5
Public Const KEY_UP As Integer = vbKeyNumpad8
Public Const KEY_DN As Integer = vbKeyNumpad2
Public Const KEY_LF As Integer = vbKeyNumpad4
Public Const KEY_RT As Integer = vbKeyNumpad6
Public Const KEY_LFUP As Integer = vbKeyNumpad7
Public Const KEY_LFDN As Integer = vbKeyNumpad1
Public Const KEY_RTUP As Integer = vbKeyNumpad9
Public Const KEY_RTDN As Integer = vbKeyNumpad3
'定义填充色
Public Const HEAD_COLOR As Long = &H80FF '蛇头颜色
Public Const BODY_COLOR As Long = vbGreen '蛇身颜色
Public Const EMPTY_COLOR As Long = &HE0E0E0 '空白地颜色
Public Const FOOD_COLOR As Long = vbBlue '食物颜色
Public Const BOMB_COLOR As Long = vbRed '炸弹颜色
Public Const FULL_COLOR As Long = 255 ^ 3
Public Const RECORD_FILE_NAME As String = "\record.dat" '记录得分榜的 文件名
Public Const MAX_PRIZE As Integer = 50 '起始 奖励分数的 上限
Public Const MIN_PRIZE As Integer = 20 '起始 奖励分数的 下限
'全局 变量
'记录玩家的相关信息和设置值：
Public Type thePlayerInfo
Score As Integer '记录得分
HeadColor As Long '蛇头填充色
BodyColor As Long '蛇身填充色
Food As Integer '记录吃进的 食物数量
Bomb As Integer '记录吃进的 炸弹数量
blnGameOver As Boolean '标记该玩家是否已经game over
' SnakeColor As Long '绘画蛇身使用的填充色……暂时省略……
SnakeLength As Integer '蛇身长度
'蛇头移动方向（值为 －1，0，1）
X_Way As Integer
Y_Way As Integer
'控制键（8个）……暂时省略（采用默认控制键）
End Type
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'记录 玩家的得分和名字
Type theRecord
Name As String * 15
Score As Integer
End Type
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'用于表示二维坐标值
Public Type thePosition
X As Integer
Y As Integer
End Type
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public FoodCount_AtOneTime As Integer '地图上同时出现的 食物数量
Public BombCount_AtOneTime As Integer '地图上同时出现的 炸弹数量
Public PrizeRemain As Integer '当前剩余的 奖励分数
Public EatCountPerShowPrize '记录 蛇每吃进多少物品（包括食物和炸弹，奖品不计）才显示一次奖品
Public AddScorePerFood As Integer '每吃进一个 食物，所增加的分数
Public AddScorePerBomb As Integer '每吃进一个 炸弹，所扣掉的分数
'**************************************************************************************************************************
Sub Main()
frmPlay.Show
frmScoreList.Show '第一次运行时先显示得分榜
End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
《主窗体 FrmPlay 代码》——
Private blnStartGame As Boolean '标记是否已经开始 新游戏（T＝游戏已经开始）
Private blnPause As Boolean '标记当前是否处于暂停状态（T＝暂停）
Private blnThroughWall As Boolean '标记是否为穿墙模式（T＝可以穿墙）
Private blnOnKeyEvents As Boolean '标记是否能够 接收键盘事件（T＝可以接收），此变量可防止 Form_KeyDown()事件重复执行
Private Map_Width As Integer '地图宽度（象素）
Private Map_Height As Integer '地图高度（象素）
Private Map_Empty_Color '地图－空白地颜色
Private Map_Bomb_Color '地图－炸弹颜色
Private Map_Food_Color '地图－食物颜色
Private MapProperty() As Integer '记录地图各个网格的属性
Private curEatCount As Integer '记录 每次出现奖品之前，一共吃进多少物品（包括食物和炸弹，奖品不计），当奖品出现后，此变量值变为 零"0"，然后进入下一次统计
Private curLevel As Integer '当前级别
Private P1 As thePlayerInfo '记录Player1 的信息
Private Snake_P1() As thePosition '记录蛇身坐标
Private PrizePos As thePosition '记录奖品的坐标
Private Record(9) As theRecord '存放前十名的 得分记录信息
Option Explicit
Private Sub cmdHelp_Click()
If blnPause = False Then Call Form_KeyDown(KEY_PAUSE, 0) '如果游戏正在进行，则发送“暂停”按键事件，暂停游戏
frmHelp.Show
End Sub
'开始新游戏
Private Sub cmdNewGame_Click()
Dim i As Integer
Randomize '重新生成随机数列
blnStartGame = Not blnStartGame
If blnStartGame Then
cmdNewGame.Caption = "停止"
Else
cmdNewGame.Caption = "新游戏"
End If
'中止游戏
If blnStartGame = False Then
'如果上一次的奖品还没有消失（以 PrizeRemain > 0 为标志），就先清除旧的奖品，然后才显示新的奖品
If PrizeRemain > 0 Then Call ShowPrize(False)
picDisplay.Cls
P1.Score = 0 '玩家的初始分数
P1.Food = 0
P1.Bomb = 0
curEatCount = 0
PrizeRemain = 0
blnPause = False
lblPause.Visible = False
lblScore.Caption = P1.Score
lblFoodCount.Caption = P1.Food
lblBombCount.Caption = P1.Bomb
P1.blnGameOver = True
HscrLevel.Enabled = True
tmrMove.Enabled = False
Exit Sub
End If
blnThroughWall = True '穿墙模式
blnOnKeyEvents = True
'暂时使用默认填充色
Map_Bomb_Color = BOMB_COLOR
Map_Empty_Color = EMPTY_COLOR
Map_Food_Color = FOOD_COLOR
P1.BodyColor = BODY_COLOR
P1.HeadColor = HEAD_COLOR
'地图初始化
ReDim MapProperty(MAX_COL_INDEX, MAX_ROW_INDEX)
Map_Width = (MAX_COL_INDEX + 1) * MAP_SCALE
Map_Height = (MAX_ROW_INDEX + 1) * MAP_SCALE
picDisplay.Cls
picDisplay.Width = Map_Width + 2
picDisplay.Height = Map_Height + 2
picDisplay.Line (0, 0)-Step(Map_Width, Map_Height), Map_Empty_Color, BF
FoodCount_AtOneTime = 2 '地图上同时存在的 食物数量
BombCount_AtOneTime = 1 '地图上同时存在的 炸弹数量
EatCountPerShowPrize = 5 '设置 蛇每吃进多少物品（包括食物和炸弹，奖品不计）才显示一次奖品
curLevel = HscrLevel.Value
AddScorePerFood = curLevel '每吃进一个 食物，所增加的分数＝当前的级别值
AddScorePerBomb = -curLevel * 2 '每吃进一个 炸弹，所扣掉的分数
P1.Score = Abs(AddScorePerBomb) + 1 '玩家的初始分数＝'每吃进一个 炸弹，所扣掉的分数＋1
P1.Food = 0
P1.Bomb = 0
PrizeRemain = 0
P1.blnGameOver = False
lblScore.Caption = P1.Score
lblFoodCount.Caption = P1.Food
lblBombCount.Caption = P1.Bomb
'初始化P1蛇身
ReDim Snake_P1(START_SNAKE_LENGTH)
For i = 0 To UBound(Snake_P1)
'设定蛇身各段的起始位置
Snake_P1(i).X = MAX_COL_INDEX - UBound(Snake_P1) + i
Snake_P1(i).Y = MAX_ROW_INDEX
'初始化移动方向
P1.X_Way = -1
P1.Y_Way = 0
MapProperty(Snake_P1(i).X, Snake_P1(i).Y) = MAP_SNAKE
picDisplay.Line (Snake_P1(i).X * MAP_SCALE, Snake_P1(i).Y * MAP_SCALE)-Step(MAP_SCALE, MAP_SCALE), BODY_COLOR, BF
Next
'使用蛇头颜色 重新绘画蛇头
picDisplay.Line (Snake_P1(0).X * MAP_SCALE, Snake_P1(0).Y * MAP_SCALE)-Step(MAP_SCALE, MAP_SCALE), HEAD_COLOR, BF
'放置食物
For i = 1 To FoodCount_AtOneTime
Call AddFood
Next
'放置炸弹
For i = 1 To BombCount_AtOneTime
Call AddBomb
Next
lblPause.Visible = False
lblScore.Caption = P1.Score
lblFoodCount.Caption = P1.Food
lblBombCount.Caption = P1.Bomb
P1.blnGameOver = False
HscrLevel.Enabled = False '游戏进行期间不能改变级别
tmrMove.Enabled = True
End Sub
'显示得分榜
Private Sub cmdShowScoreList_Click()
If blnPause = False Then Call Form_KeyDown(KEY_PAUSE, 0) '如果游戏正在进行，则发送“暂停”按键事件，暂停游戏
frmScoreList.Show
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If P1.blnGameOver Or blnStartGame = False Or blnOnKeyEvents = False Then Exit Sub '以下情况（游戏结束、游戏还没有开始、禁用击键事件）不接收按键操作。
'按“Numpad 5”键－－暂停/继续
If KeyCode = KEY_PAUSE Then
blnPause = Not blnPause
lblPause.Visible = blnPause
tmrMove.Enabled = Not blnPause
Exit Sub
End If
If blnPause Then Exit Sub '在暂停状态下不接受“ESC”外的其它按键
Select Case KeyCode
Case KEY_LFUP
blnOnKeyEvents = False
If P1.X_Way <> 0 Then
P1.X_Way = 0
P1.Y_Way = -1
ElseIf P1.Y_Way <> 0 Then
P1.X_Way = -1
P1.Y_Way = 0
End If
Case KEY_LFDN
blnOnKeyEvents = False
If P1.X_Way <> 0 Then
P1.X_Way = 0
P1.Y_Way = 1
ElseIf P1.Y_Way <> 0 Then
P1.X_Way = -1
P1.Y_Way = 0
End If
Case KEY_RTUP
blnOnKeyEvents = False
If P1.X_Way <> 0 Then
P1.X_Way = 0
P1.Y_Way = -1
ElseIf P1.Y_Way <> 0 Then
P1.X_Way = 1
P1.Y_Way = 0
End If
Case KEY_RTDN
blnOnKeyEvents = False
If P1.X_Way <> 0 Then
P1.X_Way = 0
P1.Y_Way = 1
ElseIf P1.Y_Way <> 0 Then
P1.X_Way = 1
P1.Y_Way = 0
End If
'当蛇以 水平 方向移动时，LF 和 RT 按键无效
Case KEY_LF
blnOnKeyEvents = False
If P1.X_Way = 0 Then
P1.X_Way = -1
P1.Y_Way = 0
End If
Case KEY_RT
blnOnKeyEvents = False
If P1.X_Way = 0 Then
P1.X_Way = 1
P1.Y_Way = 0
End If
'当蛇以 垂直 方向移动时，UP 和 DN 按键无效
Case KEY_UP
blnOnKeyEvents = False
If P1.Y_Way = 0 Then
P1.X_Way = 0
P1.Y_Way = -1
End If
Case KEY_DN
blnOnKeyEvents = False
If P1.Y_Way = 0 Then
P1.X_Way = 0
P1.Y_Way = 1
End If
Case Else
Exit Sub
End Select
tmrMove.Enabled = False '暂停Timer事件，等到本次移动操作全部完成后（即sub RefreshSnake(...)过程执行完毕），再启动Timer
Call PlayerMove
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
blnOnKeyEvents = True '放开一个键之后，才能接收按键事件
End Sub
Private Sub Form_Load()
Me.KeyPreview = True
picDisplay.BackColor = EMPTY_COLOR
curLevel = 6 '默认级别:6
HscrLevel.Value = curLevel
End Sub
'游戏结束
Private Sub GameOver()
Dim Ans As Integer
P1.blnGameOver = True
tmrMove.Enabled = False
If PrizeRemain > 0 Then Call ShowPrize(False)
MsgBox "游戏结束。你的得分是：" & vbCrLf & P1.Score, vbInformation, "GAME OVER"
Call CheckRecord(P1.Score) '检查分数能否上榜
Call cmdNewGame_Click '准备新一轮游戏
End Sub
'蛇移动 的处理过程
Private Sub PlayerMove()
Dim tempHead As thePosition '临时存放蛇头的新坐标
Dim blnAddLengh As Boolean '是否增加蛇身的长度（T＝增加）
'找出蛇头的新坐标
tempHead.X = Snake_P1(0).X + P1.X_Way
tempHead.Y = Snake_P1(0).Y + P1.Y_Way
If blnThroughWall Then '如果当前是 穿墙模式（默认）
If tempHead.X < 0 Then
tempHead.X = MAX_COL_INDEX
ElseIf tempHead.X > MAX_COL_INDEX Then
tempHead.X = 0
ElseIf tempHead.Y < 0 Then
tempHead.Y = MAX_ROW_INDEX
ElseIf tempHead.Y > MAX_ROW_INDEX Then
tempHead.Y = 0
End If
Else
'非 穿墙模式的移动代码未设置
End If
'判断蛇头新坐标下的 地图属性
Select Case MapProperty(tempHead.X, tempHead.Y)
Case MAP_EMPTY '空白地
'暂时没有空白地的移动操作
Case MAP_SNAKE '蛇身
'如果蛇头的新坐标 和当前 蛇尾 的坐标重合，就不算GameOver－－因为随着蛇头的移动，蛇身各个节点都会向前跟进，使得当前 蛇尾 坐标下的网格变成 空白地。
If Not (tempHead.X = Snake_P1(UBound(Snake_P1)).X And tempHead.Y = Snake_P1(UBound(Snake_P1)).Y) Then
Call GameOver
Exit Sub
End If
Case MAP_FOOD '食物
blnAddLengh = True '增加蛇身长度
P1.Food = P1.Food + 1 '统计玩家吃进的 食物数量
lblFoodCount.Caption = P1.Food '显示总共吃进的 食物数量
Call ChangeScore(AddScorePerFood, True) '加分
Call AddFood '补充地图上的 食物
Case MAP_BOMB '炸弹
P1.Bomb = P1.Bomb + 1 '统计玩家吃进的 炸弹数量
lblBombCount.Caption = P1.Bomb '显示总共吃进的 炸弹数量
Call ChangeScore(AddScorePerBomb, True) '扣分
Call AddBomb '补充地图上的 炸弹
Case MAP_PRIZE '奖品
Call ChangeScore(PrizeRemain, False)
Call ShowPrize(False) '清除地图上的奖品
End Select
Call RefreshSnake(tempHead.X, tempHead.Y, blnAddLengh) '刷新地图 上的蛇身图像
' tmrMove.Enabled = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim Ans As Integer
If blnStartGame Then ''如果游戏已经开始，则询问是否要退出
If blnPause = False Then Call Form_KeyDown(KEY_PAUSE, 0) '如果游戏正在进行，则发送“暂停”按键事件，暂停游戏
Ans = MsgBox("游戏尚未结束，确定要退出吗？", vbQuestion Or vbYesNo Or vbDefaultButton2)
If Ans = vbYes Then
End
Else
Cancel = True
End If
Else
End
End If
End Sub
'设置游戏级别（速度）
Private Sub HscrLevel_Change()
curLevel = HscrLevel.Value
lblLevel.Caption = curLevel
tmrMove.Interval = SPEED_LV1 - (curLevel - 1) * SPEED_CHANGE '根据级别，设置速度
End Sub
Private Sub tmrMove_Timer()
Call PlayerMove
End Sub
'改变玩家的分数
'参数：AddScore－－增加的分数（正数＝加分，负数＝扣分）
' blnAddEatCount－－判断是否要对curEatCount累加（T＝累加）（如果当前吃进的不是食物或炸弹，就不进行累加）
Private Sub ChangeScore(AddScore As Integer, blnAddEatCount As Boolean)
P1.Score = P1.Score + AddScore
If blnAddEatCount Then curEatCount = curEatCount + 1 '记录（累加）当前吃进的物品
'如果吃进的物品（curEatCount） 达到一定数量（EatCountPerShowPrize）就显示奖品
If curEatCount = EatCountPerShowPrize Then
curEatCount = 0 '重新累计 吃进的物品数
'如果上一次的奖品还没有消失（以 PrizeRemain > 0 为标志），就先清除旧的奖品，然后才显示新的奖品
If PrizeRemain > 0 Then Call ShowPrize(False)
Call ShowPrize(True)
End If
lblScore.Caption = P1.Score
If P1.Score <= 0 Then Call GameOver
End Sub
'增加地图上的 食物
Private Sub AddFood()
Dim tempFood As thePosition
'寻找一个空白地，用于放置食物
Do
tempFood.X = Int(Rnd() * (MAX_COL_INDEX + 1))
tempFood.Y = Int(Rnd() * (MAX_ROW_INDEX + 1))
Loop Until MapProperty(tempFood.X, tempFood.Y) = MAP_EMPTY
MapProperty(tempFood.X, tempFood.Y) = MAP_FOOD '标记地图格的属性为 食物
picDisplay.Line (tempFood.X * MAP_SCALE, tempFood.Y * MAP_SCALE)-Step(MAP_SCALE, MAP_SCALE), Map_Food_Color, BF '在地图上绘出 食物
End Sub
'增加地图上的 炸弹
Private Sub AddBomb()
Dim tempBomb As thePosition
'寻找一个空白地，用于放置炸弹
Do
tempBomb.X = Int(Rnd() * (MAX_COL_INDEX + 1))
tempBomb.Y = Int(Rnd() * (MAX_ROW_INDEX + 1))
Loop Until MapProperty(tempBomb.X, tempBomb.Y) = MAP_EMPTY
MapProperty(tempBomb.X, tempBomb.Y) = MAP_BOMB '标记地图格的属性为 炸弹
picDisplay.Line (tempBomb.X * MAP_SCALE, tempBomb.Y * MAP_SCALE)-Step(MAP_SCALE, MAP_SCALE), Map_Bomb_Color, BF '在地图上绘出 炸弹
End Sub
'在地图上显示 奖品 和 奖励分数
'参数：blnShow（T＝显示奖品,F＝清除奖品）
Private Sub ShowPrize(blnShow As Boolean)
Dim tempPrize As thePosition
Dim tempColor As Long
If blnShow Then '显示奖品
'寻找一个空白地，用于放置奖品
Do
tempPrize.X = Int(Rnd() * (MAX_COL_INDEX + 1))
tempPrize.Y = Int(Rnd() * (MAX_ROW_INDEX + 1))
Loop Until MapProperty(tempPrize.X, tempPrize.Y) = MAP_EMPTY
PrizePos = tempPrize '记录奖品的坐标
MapProperty(PrizePos.X, PrizePos.Y) = MAP_PRIZE '标记地图格的属性为 奖品
tempColor = Int(Rnd() * (FULL_COLOR + 1)) '产生随机颜色
picDisplay.Line (PrizePos.X * MAP_SCALE, PrizePos.Y * MAP_SCALE)-Step(MAP_SCALE, MAP_SCALE), tempColor, BF '在地图上用 随机颜色绘画 奖品
PrizeRemain = Int(Rnd() * (MAX_PRIZE - MIN_PRIZE + 1)) + MIN_PRIZE '随机设定 起始的奖励分数
lblPrizeRemain.ForeColor = FULL_COLOR - tempColor '剩余的分数，用反色显示
lblPrizeRemain.Caption = PrizeRemain '显示当前剩余的 奖励分数
lblPrizeRemain.Move PrizePos.X * MAP_SCALE, PrizePos.Y * MAP_SCALE, MAP_SCALE, MAP_SCALE '将显示奖励分数的 Label移动到地图中 奖品的坐标上面。
lblPrizeRemain.Visible = True
tmrPrize.Enabled = True '启动tmrPrize，不断地减少奖励分数
Else '清除奖品
picDisplay.Line (PrizePos.X * MAP_SCALE, PrizePos.Y * MAP_SCALE)-Step(MAP_SCALE, MAP_SCALE), Map_Empty_Color, BF '在地图上擦除 奖品图案
MapProperty(PrizePos.X, PrizePos.Y) = MAP_EMPTY '标记地图格的属性为 空白地
lblPrizeRemain.Visible = False
tmrPrize.Enabled = False
End If
End Sub
'刷新蛇身坐标，更新 地图网格属性 以及画面
'参数：蛇头的新坐标_X，蛇头的新坐标_Y，是否增加蛇身长度（T＝增加）
Private Sub RefreshSnake(NewHead_X As Integer, NewHead_Y As Integer, blnAddLength As Boolean)
Dim i As Integer
Dim OldTail As thePosition '用于在更新蛇身坐标之前，保存原来的 蛇尾坐标
OldTail = Snake_P1(UBound(Snake_P1)) '保存旧的蛇尾坐标
picDisplay.Line (Snake_P1(0).X * MAP_SCALE, Snake_P1(0).Y * MAP_SCALE)-Step(MAP_SCALE, MAP_SCALE), P1.BodyColor, BF '在地图上 擦除旧的的蛇头
picDisplay.Line (NewHead_X * MAP_SCALE, NewHead_Y * MAP_SCALE)-Step(MAP_SCALE, MAP_SCALE), P1.HeadColor, BF '在地图上 绘画出新的蛇头
MapProperty(NewHead_X, NewHead_Y) = MAP_SNAKE '标记蛇头新坐标下的地图格属性为 玩家蛇身
'必须先更新 蛇身 除蛇头外其余部分的坐标。否则会出错
For i = (UBound(Snake_P1)) To 1 Step -1
Snake_P1(i) = Snake_P1(i - 1)
Next
'然后更新 蛇头的坐标
Snake_P1(0).X = NewHead_X
Snake_P1(0).Y = NewHead_Y
'判断是否需要 增加蛇身长度
If blnAddLength Then '增加长度
ReDim Preserve Snake_P1(UBound(Snake_P1) + 1) '最后才设定新的 蛇尾坐标（关键字“Preserve”的作用是：保留原数组的内容）
Snake_P1(UBound(Snake_P1)) = OldTail '旧蛇尾的坐标不变
P1.SnakeLength = UBound(Snake_P1) + 1 '蛇身长度 + 1
Else '蛇身长度不变
'如果蛇头的新坐标与旧蛇尾的坐标重合，就不用在旧蛇尾的坐标下 绘画空白地的图案（因为该网格属性已经是 蛇头，而不是空白地）
If Not (NewHead_X = OldTail.X And NewHead_Y = OldTail.Y) Then
MapProperty(OldTail.X, OldTail.Y) = MAP_EMPTY '在地图上把 旧蛇尾坐标 下的地图格的属性设置为 空白地
picDisplay.Line (OldTail.X * MAP_SCALE, OldTail.Y * MAP_SCALE)-Step(MAP_SCALE, MAP_SCALE), Map_Empty_Color, BF '在地图上擦除旧蛇尾，绘画空白地
End If
End If
tmrMove.Enabled = True
End Sub
'检查得分能否上榜－－如果能上榜，则更新排行榜
Public Sub CheckRecord(Score As Integer)
Dim FileNum As Integer
Dim pos As Integer, i As Integer, list As ListBox 'pos --排名
Dim Name As String '记录玩家名称
Dim TopTen As Boolean '判断得分是否进入前十名
Dim Ans As Integer
FileNum = FreeFile
Set list = frmScoreList.lstScore '映射到列表框 frmScoreList.lstscore
Do
If Score >= Val(list.list(pos)) Then
TopTen = True
Do '循环，设置玩家玩家名称
Name = InputBox("你的得分是第 " & pos + 1 & "名" & vbCrLf & "请输入你的名称(不超过15个字符)", "进入前10名！")
If Len(Name) = 0 Then
MsgBox "你取消了 Top 10 得分登记", vbInformation
Exit Sub
End If
If Len(RTrim(Name)) > 15 Then
Ans = MsgBox("玩家名称的长度不能超过15个字符！" & vbCrLf & "你输入的 “" & Name & "”" & "将自动改为 “" & Left(Name, 15) & "”" & "是否同意？", vbQuestion Or vbYesNo, "输入玩家名称")
If Ans = vbYes Then Name = Left(Name, 15)
End If
Loop Until Len(RTrim(Name)) <= 15 And Len(RTrim(Name)) > 0 '直到玩家名称的长度符合规定，才退出循环
End If
pos = pos + 1
Loop Until pos = 10 Or TopTen = True
If TopTen = True Then
list.AddItem Score, pos - 1
frmScoreList.lstName.AddItem Name, pos - 1
If list.ListCount > 10 Then list.RemoveItem list.ListCount - 1
If frmScoreList.lstName.ListCount > 10 Then frmScoreList.lstName.RemoveItem frmScoreList.lstName.ListCount - 1
Call PutRecord '刷新 记录文件的内容
End If
End Sub
'往文件里写入 得分记录
Private Sub PutRecord()
Dim FileNum As Integer, i As Integer
FileNum = FreeFile
Open App.Path & RECORD_FILE_NAME For Random As #FileNum Len = Len(Record(0))
For i = 0 To 9
Record(i).Score = Val(frmScoreList.lstScore.list(i))
Record(i).Name = frmScoreList.lstName.list(i)
Put #FileNum, , Record(i)
Next
Close #FileNum
End Sub
'不断减少奖励的分数
Private Sub tmrPrize_Timer()
Dim tempColor As Long
PrizeRemain = PrizeRemain - 1
If PrizeRemain = 0 Then
Call ShowPrize(False) '当奖励的分数减少到零，就擦除奖品
Exit Sub
End If
tempColor = Int(Rnd() * (FULL_COLOR + 1)) '产生随机颜色
picDisplay.Line (PrizePos.X * MAP_SCALE, PrizePos.Y * MAP_SCALE)-Step(MAP_SCALE, MAP_SCALE), tempColor, BF '在地图上用 随机颜色绘画 奖品
lblPrizeRemain.ForeColor = FULL_COLOR - tempColor '剩余的分数，用反色显示
lblPrizeRemain.Caption = PrizeRemain '显示当前剩余的 奖励分数
End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
《排行榜窗体 frmScoreList 代码》——
Private Record(9) As theRecord '记录得分在前10名的 玩家的得分和名字
Option Explicit
Private Sub Form_Load()
Dim FileNum As Integer, i As Integer
lstPos.Clear
For i = 1 To 10
lstPos.AddItem i, i - 1
Next
lstScore.Clear
lstName.Clear
'读入得分记录
FileNum = FreeFile
Open App.Path & RECORD_FILE_NAME For Random As #FileNum Len = Len(Record(0))
' Call ScoreSort(FileNum)
For i = 0 To 9
Get #FileNum, , Record(i)
lstScore.AddItem Record(i).Score, i
lstName.AddItem Record(i).Name, i
Next
Close #FileNum
End Sub
'同步3个ListBox——
Private Sub lstName_Click()
lstPos.ListIndex = lstName.ListIndex
lstScore.ListIndex = lstName.ListIndex
End Sub
Private Sub lstPos_Click()
lstScore.ListIndex = lstPos.ListIndex
lstName.ListIndex = lstPos.ListIndex
End Sub
Private Sub lstscore_Click()
lstPos.ListIndex = lstScore.ListIndex
lstName.ListIndex = lstScore.ListIndex
End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
《说明窗体 frmHelp 》——
只需添加一个textBox,其text属性填入操作说明如下：
《贪食蛇 1.1单人版(穿墙)》游戏说明
（1）控制键：
“Enter”－－新游戏/中止游戏；
“5”－－暂停/恢复－(数字键盘区,NumLock状态)；
方向控制－(数字键盘区,NumLock状态)：
“8、2、4、6”－－上、下、左、右；
“1”－－左 / 下；
“3”－－右 / 下；
“7”－－左 / 上；
“9”－－右 / 上。 ( 当蛇头和蛇身任一节重合时,游戏结束
（2）地图：
蓝色方格－－食物 (吃进食物后,蛇身长度增加一节)；
红色方格－－炸弹；
淡紫色方格－－蛇头；
亮绿色长条－－蛇身。
闪烁的方格－－奖品；
(奖品上面的数字表示吃进奖品后 增加的分数。)
( 每个奖品分数的 初始值是20～50之间的随机数，当奖品出现
后奖励的分数就会不断减少。)
（3）计分方法：
( 当总分 < = 0 时,游戏结束)
每吃进一个食物 增加的分数等于 级别的数值；
每吃进一个炸弹 扣掉的分数是 级别数值的2倍；
玩家起始分数等于 级别数值的 2倍再加1分。
(例如 等级为6，则玩家起始分数是13分；每吃进一个食物加6
分；
每吃进一个炸弹减12分)
游戏运行之后会在所在目录下创建一个"Record.dat"的文件，
存放得分记录。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝