编程高手之路—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(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