1.VB贪吃蛇代码

VB贪吃蛇代码

       '定义蛇的运动速度枚举值

       Private Enum tpsSpeed

        QUICKLY = 0

        SLOWLY = 1

       End Enum

       '定义蛇的运动方向枚举值

       Private Enum tpsDirection

        D_UP =

        D_DOWN =

        D_LEFT =

        D_RIGHT =

       End Enum

       '定义运动区域4个禁区的枚举值

       Private Enum tpsForbiddenZone

        FZ_TOP =

        FZ_BOTTOM =

        FZ_LEFT =

        FZ_RIGHT =

       End Enum

       '定义蛇头及身体初始化数枚举值

       Private Enum tpsSnake

        SNAKEONE = 1

        SNAKETWO = 2

        SNAKETHREE = 3

        SNAKEFOUR = 4

       End Enum

       '定义蛇宽度的常量

       Private Const SNAKEWIDTH As Integer =

       '该过程用于显示游戏信息

       Private Sub Form_Load()

        Me.Show

        Me.lblTitle = "BS贪食蛇 — (版本 " & App.Major & "." & App.Minor & "." & App.Revision & ")"

        Me.Caption = Me.lblTitle.Caption

        frmSplash.Show 1

       End Sub

       '该过程用于使窗体恢复原始大小

       Private Sub Form_Resize()

        If Me.WindowState <> 1 The贪食c arima源码n

        Me.Caption = ""

        Me.Height = '窗体高度为 缇

        Me.Width = '窗体宽度为 缇

        Me.Left = (Screen.Width - Width) \ 2

        Me.Top = (Screen.Height - Height) \ 2

        End If

       End Sub

       '该过程用于重新开始开始游戏

       Private Sub cmdGameStart_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

        Beep

        msg = MsgBox("您确认要重新开始游戏吗？", 4 + , "BS贪食蛇")

        If msg = 6 Then Call m_subGameInitialize

       End Sub

       '该过程用于暂停/运行游戏

       Private Sub chkPause_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

        If Me.chkPause.Caption = "暂停游戏(&P)" Then

        Me.tmrSnakeMove.Enabled = False

        Me.tmrGameTime.Enabled = False

        Me.picMoveArea.Enabled = False

        Me.lblPauseLab.Visible = True

        Me.chkPause.Caption = "继续游戏(&R)"

        Else

        Me.tmrSnakeMove.Enabled = True

        Me.tmrGameTime.Enabled = True

        Me.picMoveArea.Enabled = True

        Me.lblPauseLab.Visible = False

        Me.chkPause.Caption = "暂停游戏(&P)"

        End If

       End Sub

       '该过程用于显示游戏规则

       Private Sub cmdGameRules_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

        Beep

        MsgBox " BS贪食蛇：一个规则最简单的趣味游戏，您将用键盘" & Chr() & _

        "上的4个方向键来控制蛇的运动方向。在运动过程中蛇" & Chr() & _

        "不能后退，蛇的头部也不能接触到运动区域的边线以外" & Chr() & _

        "和蛇自己的身体，否则就游戏失败。在吃掉随机出现的" & Chr() & _

        "果子后，蛇的身体会变长，越长难度越大。祝您好运！！", 0 + , "游戏规则"

       End Sub

       '该过程用于显示游戏开发信息

       Private Sub cmdAbout_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

        Beep

        MsgBox "BS贪食蛇" & "(V-" & App.Major & "." & App.Minor & "版本)" & Chr() & Chr() & _

        "" & Chr() & Chr() & _

        "由PigheadPrince设计制作" & Chr() & _

        "CopyRight(C),BestSoft.TCG", 0, "关于本游戏"

       End Sub

       '该过程用于退出游戏

       Private Sub cmdExit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

        Beep

        msg = MsgBox("您要退出本游戏吗？", 4 + , "BS贪食蛇")

        Select Case msg

        Case 6

        End

        Case 7

        Me.chkWindowButton(2).Value = 0

        Exit Sub

        End Select

       End Sub

       '该过程用于拖动窗体_(点击图标)

       Private Sub imgWindowTop_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

        ReleaseCapture

        SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0

       End Sub

       '该共用过程用于处理窗体控制按钮组的相关操作_(锁定、最小化、退出)

       Private Sub chkWindowButton_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

        If Button <> 1 Then Exit Sub

        Select Case Index

        Case 0 '锁定窗体

        If Me.chkWindowButton(0).Value = 1 Then

        Me.imgWindowTop.BorderStyle = 0

        Me.imgWindowTop.Enabled = False

        Else

        Me.imgWindowTop.BorderStyle = 1

        Me.imgWindowTop.Enabled = True

        End If

        Case 1 '最小化

        Me.WindowState = 1

        Me.chkWindowButton(1).Value = 0

        Me.Caption = "BS贪食蛇 — (V-" & App.Major & "." & App.Minor & "版本)"

        Case 2 '退出

        Beep

        msg = MsgBox("您要退出本游戏吗？", 4 + , "BS贪食蛇")

        Select Case msg

        Case 6

        End

        Case 7

        Me.chkWindowButton(2).Value = 0

        Exit Sub

        End Select

        End Select

       End Sub

       '该过程用于设置蛇运动速度的快慢

       Private Sub hsbGameSpeed_Change()

        Me.tmrSnakeMove.Interval = Me.hsbGameSpeed.Value

       End Sub

       '该过程用于通过键盘的方向键改变蛇的运动方向

       Private Sub picMoveArea_KeyDown(KeyCode As Integer, Shift As Integer)

        Select Case g_intDirection

        Case D_UP

        If KeyCode = D_DOWN Then Exit Sub

        Case D_DOWN

        If KeyCode = D_UP Then Exit Sub

        Case D_LEFT

        If KeyCode = D_RIGHT Then Exit Sub

        Case D_RIGHT

        If KeyCode = D_LEFT Then Exit Sub

        End Select

        g_intDirection = KeyCode

       End Sub

       '该计时循环过程用于计算游戏耗费的秒数并显示

       Private Sub tmrGameTime_Timer()

        g_lngGameTime = g_lngGameTime + 1

        Me.lblGameTime.Caption = g_lngGameTime & "秒"

       End Sub

       '该计时循环过程用于控制蛇的行动轨迹

       Private Sub tmrSnakeMove_Timer()

        Dim lngSnakeX As Long, lngSnakeY As Long, lngSnakeColor As Long

        Dim lngPointX As Long, lngPointY As Long, lngPointColor As Long

        Randomize

        Me.picMoveArea.SetFocus

        Me.picMoveArea.Cls

        '确认蛇头的运动方向并获取新的位置

        Select Case g_intDirection

        Case D_UP '向上运动

        g_udtSnake(SNAKEONE).Snake_CurX = g_udtSnake(SNAKEONE).Snake_OldX

        g_udtSnake(SNAKEONE).Snake_CurY = g_udtSnake(SNAKEONE).Snake_OldY

        g_udtSnake(SNAKEONE).Snake_CurY = g_udtSnake(SNAKEONE).Snake_CurY - SNAKEWIDTH

        Case D_DOWN '向下运动

        g_udtSnake(SNAKEONE).Snake_CurX = g_udtSnake(SNAKEONE).Snake_OldX

        g_udtSnake(SNAKEONE).Snake_CurY = g_udtSnake(SNAKEONE).Snake_OldY

        g_udtSnake(SNAKEONE).Snake_CurY = g_udtSnake(SNAKEONE).Snake_CurY + SNAKEWIDTH

        Case D_LEFT '向左运动

        g_udtSnake(SNAKEONE).Snake_CurX = g_udtSnake(SNAKEONE).Snake_OldX

        g_udtSnake(SNAKEONE).Snake_CurX = g_udtSnake(SNAKEONE).Snake_CurX - SNAKEWIDTH

        g_udtSnake(SNAKEONE).Snake_CurY = g_udtSnake(SNAKEONE).Snake_OldY

        Case D_RIGHT '向右运动

        g_udtSnake(SNAKEONE).Snake_CurX = g_udtSnake(SNAKEONE).Snake_OldX

        g_udtSnake(SNAKEONE).Snake_CurX = g_udtSnake(SNAKEONE).Snake_CurX + SNAKEWIDTH

        g_udtSnake(SNAKEONE).Snake_CurY = g_udtSnake(SNAKEONE).Snake_OldY

        End Select

        '根据新的位置绘制蛇头

        lngSnakeX = g_udtSnake(SNAKEONE).Snake_CurX

        lngSnakeY = g_udtSnake(SNAKEONE).Snake_CurY

        lngSnakeColor = g_udtSnake(SNAKEONE).Snake_Color

        Me.picMoveArea.PSet (lngSnakeX, lngSnakeY), lngSnakeColor

        '移动蛇身体其他部分的位置

        For i = 2 To g_intSnakeLength

        g_udtSnake(i).Snake_CurX = g_udtSnake(i - 1).Snake_OldX

        g_udtSnake(i).Snake_CurY = g_udtSnake(i - 1).Snake_OldY

        lngSnakeX = g_udtSnake(i).Snake_CurX

        lngSnakeY = g_udtSnake(i).Snake_CurY

        lngSnakeColor = g_udtSnake(i).Snake_Color

        Me.picMoveArea.PSet (lngSnakeX, lngSnakeY), lngSnakeColor

        Next i

        '更新蛇旧的坐标位置

        For j = 1 To g_intSnakeLength

        g_udtSnake(j).Snake_OldX = g_udtSnake(j).Snake_CurX

        g_udtSnake(j).Snake_OldY = g_udtSnake(j).Snake_CurY

        Next j

        '判断蛇在移动中是否到了禁区而导致游戏失败

        If m_funMoveForbiddenZone(g_udtSnake(SNAKEONE).Snake_CurX, g_udtSnake(SNAKEONE).Snake_CurY) Then

        Beep

        MsgBox "您的蛇移动到了禁区，游戏失败！", 0 + , "BS贪食蛇"

        Me.tmrSnakeMove.Enabled = False

        Me.tmrGameTime.Enabled = False

        Me.picMoveArea.Visible = False

        Exit Sub

        End If

        '判断蛇在移动中是否碰到了自己的身体而导致游戏失败

        If m_funTouchSnakeBody(g_udtSnake(SNAKEONE).Snake_CurX, g_udtSnake(SNAKEONE).Snake_CurY) Then

        Beep

        MsgBox "您的蛇在移动中碰到了自己的身体，游戏失败！", 0 + , "BS贪食蛇"

        Me.tmrSnakeMove.Enabled = False

        Me.tmrGameTime.Enabled = False

        Me.picMoveArea.Visible = False

        Exit Sub

        End If

        '判断蛇是否吃到了果子

        If m_funEatPoint(g_udtSnake(SNAKEONE).Snake_CurX, g_udtSnake(SNAKEONE).Snake_CurY) Then

        '累加玩家的得分并刷新得分显示

        g_intPlayerScore = g_intPlayerScore + 1

        Me.lblYourScore.Caption = g_intPlayerScore & "分"

        Call m_subAddSnake '加长蛇的身体

        Call m_subGetPoint '获取下一个果子的位置和颜色

        Else

        '绘制果子

        lngPointX = g_udtPoint.Point_X

        lngPointY = g_udtPoint.Point_Y

        lngPointColor = g_udtPoint.Point_Color

        Me.picMoveArea.PSet (lngPointX, lngPointY), lngPointColor

        End If

       End Sub

       '该私有子过程用于初始化游戏

       Private Sub m_subGameInitialize()

        Erase g_udtSnake '清空蛇的结构数组

        g_intPlayerScore = 0 '清空玩家的得分

        g_lngGameTime = 0 '清空游戏耗费的秒数

        g_intDirection = D_DOWN '设定蛇的初始运动方向为下

        g_intSnakeLength = 4 '设定蛇的初始长度

        ReDim g_udtSnake(1 To g_intSnakeLength) '重新定义蛇的长度

        '定义蛇头部的数据

        With g_udtSnake(SNAKEONE)

        .Snake_OldX =

        .Snake_OldY =

        .Snake_Color = vbBlack

        End With

        '定义蛇身第2节的数据

        With g_udtSnake(SNAKETWO)

        .Snake_OldX =

        .Snake_OldY =

        .Snake_Color = vbGreen

        End With

        '定义蛇身第3节的数据

        With g_udtSnake(SNAKETHREE)

        .Snake_OldX =

        .Snake_OldY =

        .Snake_Color = vbYellow

        End With

        '定义蛇身第4节的数据

        With g_udtSnake(SNAKEFOUR)

        .Snake_OldX =

        .Snake_OldY =

        .Snake_Color = vbRed

        End With

        Me.picMoveArea.Visible = True

        Me.lblYourScore.Caption = g_intPlayerScore & "分"

        Me.lblGameTime.Caption = g_lngGameTime & "秒"

        Me.tmrSnakeMove.Interval = Me.hsbGameSpeed.Value

        Me.tmrSnakeMove.Enabled = True

        Me.tmrGameTime.Enabled = True

        Call m_subGetPoint '获取第一个果子的位置和颜色

       End Sub

       '该私有子过程用于返回获取的果子的位置和颜色信息

       Private Sub m_subGetPoint()

        Dim lngRedValue As Long, lngGreenValue As Long, lngBlueValue As Long

        Dim lngPointX As Long, lngPointY As Long, lngPointColor As Long

        '随机获取果子的颜色

        lngRedValue = Int(( - 0 + 1) * Rnd + 0)

        lngGreenValue = Int(( - 0 + 1) * Rnd + 0)

        lngBlueValue = Int(( - 0 + 1) * Rnd + 0)

        lngPointColor = RGB(lngRedValue, lngGreenValue, lngBlueValue)

        '随机获取果子的位置

        lngPointX = Int((FZ_LEFT - FZ_RIGHT + 1) * Rnd + FZ_RIGHT)

        lngPointY = Int((FZ_TOP - FZ_BOTTOM + 1) * Rnd + FZ_BOTTOM)

        Me.PSet (lngPointX, lngPointY), lngPointColor

        '设置函数返回值

        With g_udtPoint

        .Point_X = lngPointX

        .Point_Y = lngPointY

        .Point_Color = lngPointColor

        End With

       End Sub

       '该私有子过程用于加长蛇的身体

       Private Sub m_subAddSnake()

        Dim udtSnakeTemp() As Snake

        Dim lngSnakeX As Long, lngSnakeY As Long, lngSnakeColor As Long

        '备份蛇原先身体的数据并使蛇的身体加长

        ReDim udtSnakeTemp(1 To g_intSnakeLength)

        For k = 1 To g_intSnakeLength

        With udtSnakeTemp(k)

        .Snake_CurX = g_udtSnake(k).Snake_CurX

        .Snake_CurY = g_udtSnake(k).Snake_CurY

        .Snake_OldX = g_udtSnake(k).Snake_OldX

        .Snake_OldY = g_udtSnake(k).Snake_OldY

        .Snake_Color = g_udtSnake(k).Snake_Color

        End With

        Next k

        g_intSnakeLength = g_intSnakeLength + 1

        ReDim g_udtSnake(g_intSnakeLength)

        '将备份蛇身体的数据返回到加长的蛇身数组中

        For l = 1 To g_intSnakeLength - 1

        With g_udtSnake(l)

        .Snake_CurX = udtSnakeTemp(l).Snake_CurX

        .Snake_CurY = udtSnakeTemp(l).Snake_CurY

        .Snake_OldX = udtSnakeTemp(l).Snake_OldX

        .Snake_OldY = udtSnakeTemp(l).Snake_OldY

        .Snake_Color = udtSnakeTemp(l).Snake_Color

        End With

        Next l

        '写入新加入的身体数据

        Select Case g_intDirection

        Case D_UP

        With g_udtSnake(g_intSnakeLength)

        .Snake_OldX = g_udtSnake(g_intSnakeLength - 1).Snake_CurX + SNAKEWIDTH

        .Snake_OldY = g_udtSnake(g_intSnakeLength - 1).Snake_CurY

        .Snake_Color = g_udtPoint.Point_Color

        End With

        Case D_DOWN

        With g_udtSnake(g_intSnakeLength)

        .Snake_OldX = g_udtSnake(g_intSnakeLength - 1).Snake_CurX - SNAKEWIDTH

        .Snake_OldY = g_udtSnake(g_intSnakeLength - 1).Snake_CurY

        .Snake_Color = g_udtPoint.Point_Color

        End With

        Case D_LEFT

        With g_udtSnake(g_intSnakeLength)

        .Snake_OldX = g_udtSnake(g_intSnakeLength - 1).Snake_CurX

        .Snake_OldY = g_udtSnake(g_intSnakeLength - 1).Snake_CurY + SNAKEWIDTH

        .Snake_Color = g_udtPoint.Point_Color

        End With

        Case D_RIGHT

        With g_udtSnake(g_intSnakeLength)

        .Snake_OldX = g_udtSnake(g_intSnakeLength - 1).Snake_CurX

        .Snake_OldY = g_udtSnake(g_intSnakeLength - 1).Snake_CurY - SNAKEWIDTH

        .Snake_Color = g_udtPoint.Point_Color

        End With

        End Select

        lngSnakeX = g_udtSnake(g_intSnakeLength).Snake_CurX

        lngSnakeY = g_udtSnake(g_intSnakeLength).Snake_CurY

        lngSnakeColor = g_udtSnake(g_intSnakeLength).Snake_Color

        Me.picMoveArea.PSet (lngSnakeX, lngSnakeY), lngSnakeColor

       End Sub

       '该自定义函数用于返回运动的蛇是否到达禁区而导致游戏失败

       Private Function m_funMoveForbiddenZone(SnakeX As Long, SnakeY As Long) As Boolean

        If (SnakeX >= FZ_LEFT And SnakeX <= FZ_RIGHT) And (SnakeY >= FZ_TOP And SnakeY <= FZ_BOTTOM) Then

        m_funMoveForbiddenZone = False

        Else

        m_funMoveForbiddenZone = True

        End If

       End Function

       '该自定义函数用于返回运动的蛇是否碰到自己的身体而导致游戏失败

       Private Function m_funTouchSnakeBody(SnakeX As Long, SnakeY As Long) As Boolean

        For m = 2 To g_intSnakeLength

        If SnakeX = g_udtSnake(m).Snake_CurX And SnakeY = g_udtSnake(m).Snake_CurY Then

        m_funTouchSnakeBody = True

        Exit For

        Else

        m_funTouchSnakeBody = False

        End If

        Next m

       End Function

       '该自定义函数用于返回运动的蛇是否吃到了果子

       Private Function m_funEatPoint(SnakeX As Long, SnakeY As Long) As Boolean

        If Abs(SnakeX - g_udtPoint.Point_X) <= SNAKEWIDTH And Abs(SnakeY - g_udtPoint.Point_Y) <= SNAKEWIDTH Then

        m_funEatPoint = True

        Else

        m_funEatPoint = False

        End If

       End Function

       '（API函数调用过程_用以实现无标题窗体的拖动操作）---------------------------------

        'RleaseCapture函数用以释放鼠标捕获

        Public Declare Function ReleaseCapture Lib "user" () As Long

        'SendMessage函数用作向Windows发送移动窗体的消息

        Public Declare Function SendMessage Lib "user" Alias "SendMessageA" (ByVal hwnd As _

        Long, ByVal wMsg As Long, ByVal wParam As Long, IParam As Any) As Long

        Public Const WM_SYSCOMMAND = &H '声明向Windows发送消息的常量

        Public Const SC_MOVE = &HF '声明控制移动窗体常量

       '（游戏变量声明部分）-------------------------------------------------------------

        '定义蛇的数据类型结构

        Public Type Snake

        Snake_OldX As Long

        Snake_OldY As Long

        Snake_CurX As Long

        Snake_CurY As Long

        Snake_Color As Long

        End Type

        '定义果子的数据类型结构

        Public Type Point

        Point_X As Long

        Point_Y As Long

        Point_Color As Long

        End Type

        '定义蛇的动态数组

        Public g_udtSnake() As Snake

        '定义果子

        Public g_udtPoint As Point

        '定义蛇的长度

        Public g_intSnakeLength As Integer

        '定义蛇的颜色

        Public g_lngSnakeColor As Long

        '定义蛇的运动方向

        Public g_intDirection As Integer

        '定义玩家的得分

        Public g_intPlayerScore As Integer

        '定义游戏耗费的秒数

        Public g_lngGameTime As Long