为了正常的体验网站,请在浏览器设置里面开启Javascript功能!

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

2010-07-24 5页 doc 31KB 538阅读

用户头像

is_457520

暂无简介

举报
编程高手之路—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     Hs...
编程高手之路—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(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
/
本文档为【编程高手之路—vb入门和游戏编写—VB 贪吃蛇 单人版游戏(三)】,请使用软件OFFICE或WPS软件打开。作品中的文字与图均可以修改和编辑, 图片更改请在作品中右键图片并更换,文字修改请直接点击文字进行修改,也可以新增和删除文档中的内容。
[版权声明] 本站所有资料为用户分享产生,若发现您的权利被侵害,请联系客服邮件isharekefu@iask.cn,我们尽快处理。 本作品所展示的图片、画像、字体、音乐的版权可能需版权方额外授权,请谨慎使用。 网站提供的党政主题相关内容(国旗、国徽、党徽..)目的在于配合国家政策宣传,仅限个人学习分享使用,禁止用于任何广告和商用目的。

历史搜索

    清空历史搜索