VB.NET 贪吃蛇 (画圆)

最新推荐文章于 2021-01-04 14:28:44 发布

Fanstorm丶

最新推荐文章于 2021-01-04 14:28:44 发布

阅读量4.4k

点赞数 11

分类专栏： VB.NET 文章标签： vb.net 游戏 class 贪吃蛇代码

本文链接：https://blog.csdn.net/wf824284257/article/details/53674499

版权

VB.NET 专栏收录该内容

3 篇文章 0 订阅

订阅专栏

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