视频讲解https://v.qq.com/x/page/y0935wgouhg.html
文字讲解：
刘金玉的零基础VB教程068期：贪吃蛇游戏开发第四节
随机生成彩色食物
食物生成
1、用到RGB函数
2、RND随机数
3、食物可以当做一个对象，那么我们可以定义一颗食物的类型，拥有坐标X，Y，颜色R,G,B
4、RGB颜色也可以定义一个类型
5、生成的食物必须在窗口内
课堂总结
1、画食物的代码写到哪里？每一次蛇的运动实际上是把界面给cls清除，我们只有每次清除后再画出来，才能看到我们的食物
2、如何保证食物生成后的位置不变？保证食物的数据位置是在全局变量中，才能保证食物位置不变
界面效果：
源代码：
代码语言：javascript复制Private Type Node '每一节蛇身
D As Integer '37左38上39右40下
X As Single 'left
Y As Single 'top
End Type
Dim W As Integer '每一节蛇身宽度
Dim sno() As Node '声明一条蛇，是动态数组
Dim currentDirect As Integer '代表蛇运动的当前方向
Private WithEvents timer1 As Timer
'定义颜色类型
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
'声明食物
Dim goods As Food
'初始化一条蛇的各个参数
Function init()
AutoRedraw = True '自动重绘
W = 200
currentDirect = 39 '默认向右运动
ReDim sno(5) As Node
'初始化各个坐标点
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
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), vbBlue, BF
Next i
End Function
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If Abs(currentDirect - KeyCode) <> 2 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
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
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
