编程高手之路—vb入门和游戏编写—VB贪吃蛇单人版游戏(三)

编程高手之路—vb入门和游戏编写—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(Sna ke_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