《编程高手之路—vb入门和游戏编写—vb贪吃蛇单人版游戏》由会员分享，可在线阅读，更多相关《编程高手之路—vb入门和游戏编写—vb贪吃蛇单人版游戏（5页珍藏版）》请在金锄头文库上搜索。
1、编程高手之路vb入门和游戏编写VB 贪吃蛇 单人版游戏(四) 刷新蛇身坐标，更新 地图网格属性 以及画面 参数：蛇头的新坐标_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) 保存旧的蛇尾坐标 picDis
2、play.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 标记蛇头新坐标下的地
3、图格属性为 玩家蛇身 必须先更新 蛇身 除蛇头外其余部分的坐标。否则会出错 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”的作用是：保留原数组的内容
4、） 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 在地图上把 旧蛇尾坐标 下的地图格的属性设置为 空
5、白地 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 A
6、s 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 & “请
7、输入你的名称(不超过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 N
8、ame = Left(Name, 15) End If Loop Until 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 frmScore
9、List.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(Rec
10、ord(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 ShowPr
11、ize(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
12、= 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 Op
13、en 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 = lstN
14、ame.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 只需
15、添加一个textBox,其text属性填入操作说明如下： 贪食蛇 1.1单人版(穿墙)游戏说明 （1）控制键： “Enter”新游戏/中止游戏； “5”暂停/恢复(数字键盘区,NumLock状态)； 方向控制(数字键盘区,NumLock状态)： “8、2、4、6”上、下、左、右； “1”左 / 下； “3”右 / 下； “7”左 / 上； “9”右 / 上。 ( 当蛇头和蛇身任一节重合时,游戏结束 （2）地图： 蓝色方格食物 (吃进食物后,蛇身长度增加一节)； 红色方格炸弹； 淡紫色方格蛇头； 亮绿色长条蛇身。 闪烁的方格奖品； (奖品上面的数字表示吃进奖品后 增加的分数。) ( 每个奖品分数的 初始值是2050之间的随机数，当奖品出现 后奖励的分数就会不断减少。) （3）计分方法： ( 当总分 = 0 时,游戏结束) 每吃进一个食物 增加的分数等于 级别的数值； 每吃进一个炸弹 扣掉的分数是 级别数值的2倍； 玩家起始分数等于 级别数值的 2倍再加1分。 (例如 等级为6，则玩家起始分数是13分；每吃进一个食物加6 分； 每吃进一个炸弹减12分) 游戏运行之后会在所在目录下创建一个“Record.dat“的文件， 存放得分记录。
