CSDN博客

img Bugs1984

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

发表于2004/3/1 10:00:00  1436人阅读

 

本文介绍编制贪吃蛇游戏的一般方法, 其中不含什么高深的算法,只使用了初级的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日 ☆☆☆

 

0 1

相关博文

我的热门文章

img
取 消
img