VB 贪吃蛇 单人版游戏(三)

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