分享
 
 
 

VB 贪吃蛇 单人版游戏 (原作)

王朝vb·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

本文介绍编制贪吃蛇游戏的一般方法, 其中不含什么高深的算法,只使用了初级的VB编程方法,通俗易懂。

各位如有任何见解,请不吝赐教。

本人QQ : 190317890 (请在身份验证里面写上“CSDN”)

邮箱 bugs1984@126.com

需要本程序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日 ☆☆☆

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有