• 首页
  • 小学语文
  • 中学语文
  • 中学英语
  • 免费论文
  • 教学随笔
  • 学生作文
  • 综合考试
  • 试题教案
  • 育儿话题
  • 教学资源
  • 编程技术
  • 博客
  • VB 贪吃蛇 单人版游戏 (原作)

    日期:2004-12-11  地址:  作者:

     

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

     

    对 VB 贪吃蛇 单人版游戏 (原作) 文章的评论    [查看网友评论]

    验证码:
    匿名发表: