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）计分方法：           
    ( 当总分 < = 0 时,游戏结束)

    每吃进一个食物 增加的分数等于 级别的数值；
    每吃进一个炸弹 扣掉的分数是 级别数值的2倍；

    玩家起始分数等于 级别数值的 2倍再加1分。
    (例如 等级为6，则玩家起始分数是13分；每吃进一个食物加6
分；
每吃进一个炸弹减12分)
    游戏运行之后会在所在目录下创建一个"Record.dat"的文件，
存放得分记录。