刘金玉的零基础VB教程071期：贪吃蛇游戏开发第七节 游戏暂停控制

'定义颜色类型
Private Type Color
    R As Integer
    G As Integer
    B As Integer
End Type
'定义食物类型
Private Type Food
    X As Single
    Y As Single
    C As Color
End Type
Private Type Node '每一节蛇身
    D As Integer '37左38上39右40下
    X As Single 'left
    Y As Single 'top
    C As Color '表示蛇身颜色
End Type
Dim W As Integer '每一节蛇身宽度
Dim sno() As Node '声明一条蛇，是动态数组
Dim currentDirect As Integer '代表蛇运动的当前方向
Dim n As Long '代表蛇身结点数
Private WithEvents timer1 As Timer
Private WithEvents lblscore As Label '自定义一个标签控件记录分数
Private WithEvents lblinfo As Label '定义信息说明，例如用于按下空格键暂停与开始
'声明分数变量
Dim score As Long
'声明食物
Dim goods As Food
'初始化一条蛇的各个参数
Function init()
WindowState = 2 '窗体最大化
AutoRedraw = True '自动重绘
W = 200
currentDirect = 39 '默认向右运动
n = 5
ReDim sno(n) As Node
'初始化蛇身颜色
Randomize
Dim R%, G%, B%
R = Int(Rnd * 256)
G = Int(Rnd * 256)
B = Int(Rnd * 256)
'初始化各个坐标点
Dim i As Long
For i = 0 To UBound(sno) Step 1
    sno(i).D = currentDirect
    sno(i).X = ScaleWidth / 2 + i * W
    sno(i).Y = ScaleHeight / 2
    '初始化蛇身颜色
    sno(i).C.R = R
    sno(i).C.G = G
    sno(i).C.B = B
Next i
'初始化食物数据
Call rndFood
End Function
'随机生成食物数据
Function rndFood()
Randomize
goods.X = Int(Rnd * (ScaleWidth - W))
goods.Y = Int(Rnd * (ScaleHeight - W))
goods.C.R = Int(Rnd * 256)
goods.C.G = Int(Rnd * 256)
goods.C.B = Int(Rnd * 256)
End Function
'画食物
Function drawFood()
Line (goods.X, goods.Y)-(goods.X + W, goods.Y + W), RGB(goods.C.R, goods.C.G, goods.C.B), BF
End Function
'画一条蛇
Function drawSnake()
Cls
Dim i As Long
For i = 0 To UBound(sno) Step 1
    Line (sno(i).X, sno(i).Y)-(sno(i).X + W, sno(i).Y + W), RGB(sno(i).C.R, sno(i).C.G, sno(i).C.B), BF
Next i
End Function
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 32 And timer1.Enabled = True Then '暂停游戏
    timer1.Enabled = False
    lblinfo.Visible = True
Else '开始游戏
    timer1.Enabled = True
    lblinfo.Visible = False
End If
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If Abs(currentDirect - KeyCode) <> 2 And Abs(currentDirect - KeyCode) < 4 Then currentDirect = KeyCode
End Sub
Private Sub Form_Load()
Call init
Call drawSnake
'对时钟控件进行初始化
Set timer1 = Controls.Add("vb.timer", "timer1")
timer1.Interval = 100
timer1.Enabled = True
'对分数标签初始化
Set lblscore = Controls.Add("vb.label", "lblscore")
lblscore.AutoSize = True
lblscore.BackStyle = vbTransparent
lblscore.Caption = "得分：" & score
lblscore.Move 100, 100
lblscore.Visible = True
'初始化信息标签
Set lblinfo = Controls.Add("vb.label", "lblinfo")
lblinfo.AutoSize = True
lblinfo.BackStyle = vbTransparent
lblinfo.Caption = "暂停，按空格键开始"
lblinfo.FontSize = 20
lblinfo.Move ScaleWidth / 2 - lblinfo.Width / 2, ScaleHeight / 2 - lblinfo.Height
lblinfo.Visible = False
End Sub
'运动思路：插入头结点，删除尾节点
Function sport()
Dim i As Long
'将每一个节点数据向前移动一位
For i = 1 To UBound(sno) Step 1
    sno(i - 1) = sno(i)
Next i
'将头结点，也就是数组的最后一位重新复制
If currentDirect = 37 Then
    sno(UBound(sno)).X = sno(UBound(sno)).X - W
ElseIf currentDirect = 38 Then
    sno(UBound(sno)).Y = sno(UBound(sno)).Y - W
ElseIf currentDirect = 39 Then
    sno(UBound(sno)).X = sno(UBound(sno)).X + W
ElseIf currentDirect = 40 Then
    sno(UBound(sno)).Y = sno(UBound(sno)).Y + W
End If
End Function
'蛇的运动
Private Sub timer1_Timer()
Call sport
Call drawSnake
'判断是否撞到窗体边缘
If isCrashWall Then
    If MsgBox("GAME OVER ！是否重新开始？", vbYesNo, "游戏结束") = vbYes Then
        Call init
    Else
        End
    End If
End If
'画食物
Call drawFood
'判断是否吃到食物
If isEatFood Then
    '增长蛇身
    n = n + 1
    score = score + 1
    lblscore.Caption = "得分：" & score
    ReDim Preserve sno(n)
    sno(n).D = currentDirect
    sno(n).C.R = goods.C.R
    sno(n).C.G = goods.C.G
    sno(n).C.B = goods.C.B
    If currentDirect = 37 Then
        sno(n).X = sno(n - 1).X - W
        sno(n).Y = sno(n - 1).Y
    ElseIf currentDirect = 39 Then
        sno(n).X = sno(n - 1).X + W
        sno(n).Y = sno(n - 1).Y
    ElseIf currentDirect = 38 Then
        sno(n).X = sno(n - 1).X
        sno(n).Y = sno(n - 1).Y - W
    ElseIf currentDirect = 40 Then
        sno(n).X = sno(n - 1).X
        sno(n).Y = sno(n - 1).Y + W
    End If
    '随机生成食物
    Call rndFood
End If
End Sub
'是否撞到窗体边缘，撞到返回true，否则就是false
Function isCrashWall() As Boolean
isCrashWall = False
If sno(UBound(sno)).X + W > ScaleWidth _
  Or sno(UBound(sno)).X < 0 _
  Or sno(UBound(sno)).Y < 0 _
  Or sno(UBound(sno)).Y + W > ScaleHeight Then
    isCrashWall = True '撞到了
End If
End Function
'是否吃到食物，true吃到，false没吃到
Function isEatFood()
'默认没有吃到
isEatFood = False
'判断是否吃到，就是判断蛇头与食物是否碰撞
If sno(UBound(sno)).X + W > goods.X _
   And sno(UBound(sno)).X < goods.X + W _
   And sno(UBound(sno)).Y + W > goods.Y _
   And sno(UBound(sno)).Y < goods.Y + W Then
    isEatFood = True
End If
End Function