编程高手之路—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)计分方法:
( 当总分 < = 0 时,游戏结束)
每吃进一个食物 增加的分数等于 级别的数值;
每吃进一个炸弹 扣掉的分数是 级别数值的2倍;
玩家起始分数等于 级别数值的 2倍再加1分。
(例如 等级为6,则玩家起始分数是13分;每吃进一个食物加6
分;
每吃进一个炸弹减12分)
游戏运行之后会在所在目录下创建一个"Record.dat"的文件,
存放得分记录。