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

编程高手之路—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)) '保存旧的蛇尾坐标         picDisplay.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 '标记蛇头新坐标下的地图格属性为 玩家蛇身         '必须先更新 蛇身 除蛇头外其余部分的坐标。否则会出错     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”的作用是：保留原数组的内容）         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 '在地图上把 旧蛇尾坐标 下的地图格的属性设置为 空白地             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 As 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 & "请输入你的名称(不超过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 Name = Left(Name, 15)                                     End If             Loop Until Len(RTrim(Name)) <= 15 And 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 frmScoreList.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(Record(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 ShowPrize(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 = 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     Open 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 = lstName.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 》—— 只需添加一个textBox,其text属性填入操作说明如下： 《贪食蛇 1.1单人版(穿墙)》游戏说明 （1）控制键：    “Enter”－－新游戏/中止游戏；    “5”－－暂停/恢复－(数字键盘区,NumLock状态)； 方向控制－(数字键盘区,NumLock状态)：    “8、2、4、6”－－上、下、左、右；    “1”－－左 / 下；    “3”－－右 / 下；    “7”－－左 / 上；    “9”－－右 / 上。  ( 当蛇头和蛇身任一节重合时,游戏结束 （2）地图：     蓝色方格－－食物 (吃进食物后,蛇身长度增加一节)；     红色方格－－炸弹；         淡紫色方格－－蛇头；     亮绿色长条－－蛇身。         闪烁的方格－－奖品；     (奖品上面的数字表示吃进奖品后 增加的分数。)    ( 每个奖品分数的 初始值是20～50之间的随机数，当奖品出现 后奖励的分数就会不断减少。) （3）计分 方法 快递客服问题件处理详细方法山木方法pdf计算方法pdf华与华方法下载八字理论方法下载 ：                ( 当总分 < = 0 时,游戏结束)     每吃进一个食物 增加的分数等于 级别的数值；     每吃进一个炸弹 扣掉的分数是 级别数值的2倍；     玩家起始分数等于 级别数值的 2倍再加1分。     (例如 等级为6，则玩家起始分数是13分；每吃进一个食物加6 分； 每吃进一个炸弹减12分)     游戏运行之后会在所在目录下创建一个"Record.dat"的文件， 存放得分记录。