刘金玉的零基础VB教程070期：贪吃蛇游戏开发第六节 记分与故障排除

'定义颜色类型
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 '自定义一个标签控件记录分数
'声明分数变量
Dim score As Long
'声明食物
Dim goods As Food
'初始化一条蛇的各个参数
Function init()

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_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
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