VB.NET 贪吃蛇 (画圆)

VB.NET 贪吃蛇小游戏

效果图如下



所有代码一共300行多一点，非常简单，下面依次介绍一下

1.设计思路

这个游戏(1)呢，得有个地图(2)，有条蛇(3)，有个蛋(4)，所以一共设计了4个类，然后通过类之间的交互，在Form上的PictureBox上形成游戏效果。为什么还要弄个游戏类呢，因为这样新开一局游戏就非常简单了啊，直接new一个游戏类就可以了

窗体设计图如下：



中间的是picturebox控件，起名为picshow

2.地图类代码 Class Map

Public Class Map

Public width As Integer
Public height As Integer
Public cellWidth As Integer
Public cellHeight As Integer
Public Sub New(ByVal width As Integer, ByVal height As Integer, ByVal cellWidth As Integer, ByVal cellHeight As Integer)
Me.width = width
Me.height = height
Me.cellWidth = cellWidth
Me.cellHeight = cellHeight
End Sub

End Class

地图的长宽，还有地图单位长宽，蛇每次移动一个单位的长或者宽

3.蛇代码 Class Snake

Public Class Snake
Class SnakeBody
Public x As Integer
Public y As Integer
Public r As Integer '半径
Public c As Color   '颜色
Public Sub New(ByVal x%, ByVal y%, ByVal r%, ByVal c As Color)
Me.x = x
Me.y = y
Me.r = r
Me.c = c
End Sub
End Class

Public head As SnakeBody
Public body() As SnakeBody
Public bodyNum As Integer
Public Sub New(ByVal x%, ByVal y%, ByVal r%, ByVal c As Color)
head = New SnakeBody(x, y, r, c)
End Sub
Public Sub Move(ByVal Direction As Char, ByVal cellWidth As Integer, ByVal cellHeight As Integer)
'body移动
Dim i As Integer
If bodyNum >= 2 Then
For i = bodyNum - 1 To 1 Step -1
body(i).x = body(i - 1).x
body(i).y = body(i - 1).y
Next
End If
If bodyNum >= 1 Then
body(0).x = head.x
body(0).y = head.y
End If

'head 移动
Select Case Direction
Case "w"c
head.y -= cellHeight
Case "s"c
head.y += cellHeight
Case "a"c
head.x -= cellWidth
Case "d"c
head.x += cellWidth
End Select
End Sub

End Class

Snake类里面有一个Snakebody类，Snake分为一个head和不限量个body

4蛋类，Class Egg

Public Class Egg

Public x As Integer
Public y As Integer
Public r As Integer '半径
Public c As Color '颜色
Public rand As Random
Public Sub New()
rand = New Random()
End Sub
Public Sub RandInfo(ByVal width As Integer, ByVal height As Integer)
'将自己的坐标随机设定在地图内,随机一个半径和颜色
r = rand.Next(5, 20)
x = rand.Next(r, width - r)
y = rand.Next(r, height - r)
'随机10种颜色
Dim cr As Integer
cr = rand.Next(10)
Select Case cr
Case 0
c = Color.Red
Case 1
c = Color.Orange
Case 2
c = Color.Yellow
Case 3
c = Color.Green
Case 4
c = Color.Beige
Case 5
c = Color.Blue
Case 6
c = Color.Peru
Case 7
c = Color.Pink
Case 8
c = Color.SkyBlue
Case 9
c = Color.Salmon
End Select
End Sub

End Class

蛋有坐标，颜色，半径等参数，还有一个RandInfo函数，当蛇吃到蛋以后会调用这个函数，重置这个蛋的参数。蛋的半径决定了吃了这个蛋会得多少分。

5. Game类 Class Game

一个游戏，应该包含一个地图、一条蛇、一个蛋，嗯

还加了一个简单的保存游戏时间和分数的功能。

通过Direction来控制方向，按w、a、s、d会改变Direction

Public Class Game
Public mySnake As Snake
Public myMap As Map
Public myEgg As Egg
Public Score As Integer
Public Direction As Char = "w"c '一出来往上走
Public lk As Integer = 10  '窗体周围留空大小

Public Sub New(ByVal width As Integer, ByVal height As Integer, ByVal cellWidth As Integer, ByVal cellHeight As Integer)
myMap = New Map(width, height, cellWidth, cellHeight)
mySnake = New Snake(myMap.width \ 2, myMap.height \ 2, myMap.cellWidth, Color.Black)
myEgg = New Egg()
myEgg.RandInfo(myMap.width, myMap.height)
End Sub

Public Function JudgeDie() As Boolean
'超出map范围返回True，没超出 检测是否撞了自己
If mySnake.head.x - mySnake.head.r < 0 Or mySnake.head.x + mySnake.head.r > myMap.width Or
mySnake.head.y - mySnake.head.r < 0 Or mySnake.head.y + mySnake.head.r > myMap.height Then
Return True
ElseIf mySnake.bodyNum > 2 Then '从body(2)开始检测是否与head撞了
Dim i As Integer
For i = 2 To mySnake.bodyNum - 1
Dim d As Single
d = (mySnake.head.x - mySnake.body(i).x) ^ 2 + (mySnake.head.y - mySnake.body(i).y) ^ 2
d = Math.Sqrt(d)
Dim r1, r2 As Integer
r1 = mySnake.head.r
r2 = mySnake.body(i).r
If (d < r1 + r2) Then 'head 与body 撞了
Return True
End If
Next
Return False
Else
Return False
End If
End Function

Public Function JudgeScore() As Boolean '是否吃到蛋需要加分
'检查蛇头和蛋的距离
Dim d As Single
d = (mySnake.head.x - myEgg.x) ^ 2 + (mySnake.head.y - myEgg.y) ^ 2
d = Math.Sqrt(d)
Dim r1, r2 As Integer
r1 = mySnake.head.r
r2 = myEgg.r
If (d < r1 + r2) Then ' eat egg
'inc score
Score += myEgg.r
'inc snakebody
Dim x, y As Integer
Select Case Direction
Case "w"
x = mySnake.head.x
y = mySnake.head.y - myEgg.r
Case "s"
x = mySnake.head.x
y = mySnake.head.y + myEgg.r
Case "a"
x = mySnake.head.x + myEgg.r
y = mySnake.head.y
Case "d"
x = mySnake.head.x - myEgg.r
y = mySnake.head.y
End Select
ReDim Preserve mySnake.body(mySnake.bodyNum + 1)
mySnake.body(mySnake.bodyNum) = New Snake.SnakeBody(x, y, mySnake.head.r, myEgg.c)

d35e
mySnake.bodyNum += 1
'randinfo egg
myGame.myEgg.RandInfo(myMap.width, myMap.height)

Return True
End If
Return False
End Function

Public Sub WriteToFile()
Dim path As String = Application.StartupPath & "\record.txt"
If (Not IO.File.Exists(path)) Then
Dim sw As IO.StreamWriter = IO.File.CreateText(path)
Using (sw)
sw.WriteLine(Now() & " " & "Score= " & Score)
End Using
MessageBox.Show("创建记录文件")
Exit Sub
End If
Dim sw1 = IO.File.AppendText(path)
Using (sw1)
sw1.WriteLine(Now() & " " & "Score= " & Score)
End Using
End Sub

Public Sub ReadFile()
Dim path As String = Application.StartupPath & "\record.txt"
If (Not IO.File.Exists(path)) Then
MessageBox.Show("记录文件不存在")
Exit Sub
End If
Dim txt As String = IO.File.ReadAllText(path)
MessageBox.Show(txt)
End Sub
End Class

6.模块和窗体代码

模块代码，给一个Game类就可以了

Module Module1
Public myGame As Game
End Module

窗体代码

Option Explicit On

Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
myGame = New Game(500, 500, 10, 10)
PicShow.Width = myGame.myMap.width + 1
PicShow.Height = myGame.myMap.height + 1 '为什么都+1，把+1去掉后运行一下看看就知道了
PicShow.Left = myGame.lk
PicShow.Top = 3 * myGame.lk
Me.Width = PicShow.Width + 4 * myGame.lk
Me.Height = PicShow.Height + 8 * myGame.lk
Timer1.Enabled = False
End Sub
Private Sub PicShow_Paint(sender As Object, e As PaintEventArgs) Handles PicShow.Paint

'Paint the grid
Dim x, y, i As Integer
Dim sw, sh, w, h As Integer
sw = myGame.myMap.cellWidth
sh = myGame.myMap.cellHeight
w = myGame.myMap.width
h = myGame.myMap.height
x = w \ sw
y = h \ sh
Dim mygraphics As Graphics
mygraphics = e.Graphics
For i = 0 To x Step x
mygraphics.DrawLine(Pens.Black, i * sw, 0, i * sw, h)
Next
For i = 0 To y Step y
mygraphics.DrawLine(Pens.Black, 0, i * sh, w, i * sh)
Next

'paint the snake head
Dim mybrush As New SolidBrush(myGame.mySnake.head.c)
Dim r As Integer
x = myGame.mySnake.head.x
y = myGame.mySnake.head.y
r = myGame.mySnake.head.r
Dim rect As Rectangle = New Rectangle(x - r, y - r, 2 * r, 2 * r)
myGraphics.DrawEllipse(Pens.Black, rect)
myGraphics.FillEllipse(mybrush, rect)
mybrush = Nothing
'paint the snake body
If (myGame.mySnake.bodyNum > 0) Then
For i = 0 To myGame.mySnake.bodyNum - 1
x = myGame.mySnake.body(i).x
y = myGame.mySnake.body(i).y
r = myGame.mySnake.body(i).r
Dim mybrush1 As New SolidBrush(myGame.mySnake.body(i).c)
Dim mypen As New Pen(myGame.mySnake.body(i).c)
myGraphics.DrawEllipse(mypen, x - r, y - r, 2 * r, 2 * r)
myGraphics.FillEllipse(mybrush1, x - r, y - r, 2 * r, 2 * r)
Next
End If
'paint the egg
x = myGame.myEgg.x
y = myGame.myEgg.y
r = myGame.myEgg.r
Dim mybrush2 As New SolidBrush(myGame.myEgg.c)
Dim mypen2 As New Pen(myGame.myEgg.c)
myGraphics.DrawEllipse(mypen2, x - r, y - r, 2 * r, 2 * r)
myGraphics.FillEllipse(mybrush2, x - r, y - r, 2 * r, 2 * r)

End Sub

Private Sub MnuStart_Click(sender As Object, e As EventArgs) Handles MnuStart.Click
Select Case MnuStart.Text
Case "开始游戏(Enter)"
myGame = New Game(500, 500, 10, 10)
Dim gr As Graphics
gr = PicShow.CreateGraphics()
Dim mybrush As New SolidBrush(myGame.mySnake.head.c)
Dim x, y, r As Integer
x = myGame.mySnake.head.x
y = myGame.mySnake.head.y
r = myGame.mySnake.head.r
Dim rect As Rectangle = New Rectangle(x - r, y - r, 2 * r, 2 * r)
gr.DrawEllipse(Pens.Black, rect)
gr.FillEllipse(mybrush, rect)
Timer1.Enabled = True
MnuStart.Text = "暂停游戏(Enter)"
Case "暂停游戏(Enter)"
Timer1.Enabled = False
MnuStart.Text = "继续游戏(Enter)"
Case "继续游戏(Enter)"
Timer1.Enabled = True
MnuStart.Text = "暂停游戏(Enter)"
End Select
End Sub

Private Sub MnuQuit_Click(sender As Object, e As EventArgs) Handles MnuQuit.Click
End
End Sub

Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Dim sw, sh As Integer
sw = myGame.myMap.cellWidth
sh = myGame.myMap.cellHeight
myGame.mySnake.Move(myGame.Direction, sw, sh)
PicShow.Refresh()
'撞墙死亡检测
If myGame.JudgeDie Then
Timer1.Enabled = False
MessageBox.Show("撞死了！您的分数为： " & myGame.Score, "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
myGame.WriteToFile()
MnuStart.Text = "开始游戏(Enter)"
MnuScore.Text = "分数： 0"
Exit Sub
End If
'吃蛋检测
If myGame.JudgeScore Then
MnuScore.Text = "分数： " & myGame.Score
Exit Sub
End If

End Sub

Private Sub Form1_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
Select Case e.KeyCode
Case Keys.W
If (myGame.Direction = "s"c) Then Exit Sub
myGame.Direction = "w"c
Case Keys.S
If (myGame.Direction = "w"c) Then Exit Sub
myGame.Direction = "s"c
Case Keys.A
If (myGame.Direction = "d"c) Then Exit Sub
myGame.Direction = "a"c
Case Keys.D
If (myGame.Direction = "a"c) Then Exit Sub
myGame.Direction = "d"c
Case Keys.Enter
MnuStart_Click(sender, e)
End Select
End Sub

Private Sub MnuRecord_Click(sender As Object, e As EventArgs) Handles MnuRecord.Click
myGame.ReadFile()
End Sub

Private Sub 帮助ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 帮助ToolStripMenuItem.Click
Dim msg As String
msg = "游戏方法：" & vbCrLf
msg &= "使用w，a,s,d来控制方向" & vbCrLf
msg &= "按回车键 开始/暂停"
MessageBox.Show(msg, "帮助")
End Sub
End Class

结束

刚转入VB.NET几天，这是第一个VB.NET的小游戏！还是蛮开心的0 0