本文介绍编制贪吃蛇游戏的一般方法, 其中不含什么高深的算法,只使用了初级的VB编程方法,通俗易懂。
各位如有任何见解,请不吝赐教。
本人QQ : 190317890 (请在身份验证里面写上“CSDN”)
需要本程序VB源码文件的朋友,请留下你的 E-mail,我会尽快寄出。
================================
设计思路:
================================
(一)开始新游戏
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"的文件,
存放得分记录。
==========================================================================
☆☆☆ 错虫帝国(Bugs1984), 2003年11月1日 ☆☆☆