贪吃蛇

'定义蛇的运动速度枚举值Private Enum tpsSpeedQUICKLY = 0SLOWLY = 1End Enum'定义蛇的运动方向枚举值Private Enum tpsDirectionD_UP = 38D_DOWN = 40D_LEFT = 37D_RIGHT = 39End Enum'定义运动区域4个禁区的枚举值Private Enum tpsForbiddenZoneFZ_TOP = 30FZ_BOTTOM = 5330FZ_LEFT = 30FZ_RIGHT = 5730End Enum'定义蛇头及身体初始化数枚举值Private Enum tpsSnakeSNAKEONE = 1SNAKETWO = 2SNAKETHREE = 3SNAKEFOUR = 4End Enum'定义蛇宽度的常量Private Const SNAKEWIDTH As Integer = 100'该过程用于显示游戏信息Private Sub Form_Load()Me.ShowMe.lblTitle = "BS贪食蛇— (版本 " & App.Major & "." & App.Minor & "." & App.Revision & ")"Me.Caption = Me.lblTitle.CaptionfrmSplash.Show 1End Sub'该过程用于使窗体恢复原始大小Private Sub Form_Resize()If Me.WindowState <> 1 ThenMe.Caption = ""Me.Height = 6405 '窗体高度为 6405 缇Me.Width = 8535 '窗体宽度为 8535 缇Me.Left = (Screen.Width - Width) \ 2Me.Top = (Screen.Height - Height) \ 2End IfEnd Sub'该过程用于重新开始开始游戏Private Sub cmdGameStart_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Beepmsg = MsgBox("您确认要重新开始游戏吗？", 4 + 32, "BS贪食蛇")If msg = 6 Then Call m_subGameInitializeEnd Sub'该过程用于暂停/运行游戏Private Sub chkPause_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Me.chkPause.Caption = "暂停游戏(&P)" ThenMe.tmrSnakeMove.Enabled = FalseMe.tmrGameTime.Enabled = FalseMe.picMoveArea.Enabled = FalseMe.lblPauseLab.Visible = TrueMe.chkPause.Caption = "继续游戏(&R)"ElseMe.tmrSnakeMove.Enabled = TrueMe.tmrGameTime.Enabled = TrueMe.picMoveArea.Enabled = TrueMe.lblPauseLab.Visible = FalseMe.chkPause.Caption = "暂停游戏(&P)"End IfEnd Sub'该过程用于显示游戏规则Private Sub cmdGameRules_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)BeepMsgBox " BS贪食蛇：一个规则最简单的趣味游戏，您将用键盘" & Chr(13) & _"上的4个方向键来控制蛇的运动方向。

在运动过程中蛇" & Chr(13) & _"不能后退，蛇的头部也不能接触到运动区域的边线以外" & Chr(13) & _"和蛇自己的身体，否则就游戏失败。

在吃掉随机出现的" & Chr(13) & _"果子后，蛇的身体会变长，越长难度越大。

祝您好运！！", 0 + 64, "游戏规则"End Sub'该过程用于显示游戏开发信息Private Sub cmdAbout_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)BeepMsgBox "BS贪食蛇" & "(V-" & App.Major & "." & App.Minor & "版本)" & Chr(13) & Chr(13) & _"" & Chr(13) & Chr(13) & _"由PigheadPrince设计制作" & Chr(13) & _"CopyRight(C)2002,BestSoft.TCG", 0, "关于本游戏"End Sub'该过程用于退出游戏Private Sub cmdExit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Beepmsg = MsgBox("您要退出本游戏吗？", 4 + 32, "BS贪食蛇")Select Case msgCase 6EndCase 7Me.chkWindowButton(2).Value = 0Exit SubEnd SelectEnd Sub'该过程用于拖动窗体_(点击图标)Private Sub imgWindowTop_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)ReleaseCaptureSendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0End 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 SubSelect Case IndexCase 0 '锁定窗体If Me.chkWindowButton(0).Value = 1 ThenMe.imgWindowTop.BorderStyle = 0Me.imgWindowTop.Enabled = FalseElseMe.imgWindowTop.BorderStyle = 1Me.imgWindowTop.Enabled = TrueEnd IfCase 1 '最小化Me.WindowState = 1Me.chkWindowButton(1).Value = 0Me.Caption = "BS贪食蛇— (V-" & App.Major & "." & App.Minor & "版本)"Case 2 '退出Beepmsg = MsgBox("您要退出本游戏吗？", 4 + 32, "BS贪食蛇")Select Case msgCase 6EndCase 7Me.chkWindowButton(2).Value = 0Exit SubEnd SelectEnd SelectEnd Sub'该过程用于设置蛇运动速度的快慢Private Sub hsbGameSpeed_Change()Me.tmrSnakeMove.Interval = Me.hsbGameSpeed.ValueEnd Sub'该过程用于通过键盘的方向键改变蛇的运动方向Private Sub picMoveArea_KeyDown(KeyCode As Integer, Shift As Integer)Select Case g_intDirectionCase D_UPIf KeyCode = D_DOWN Then Exit SubCase D_DOWNIf KeyCode = D_UP Then Exit SubCase D_LEFTIf KeyCode = D_RIGHT Then Exit SubCase D_RIGHTIf KeyCode = D_LEFT Then Exit SubEnd Selectg_intDirection = KeyCodeEnd Sub'该计时循环过程用于计算游戏耗费的秒数并显示Private Sub tmrGameTime_Timer()g_lngGameTime = g_lngGameTime + 1Me.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 RandomizeMe.picMoveArea.SetFocusMe.picMoveArea.Cls'确认蛇头的运动方向并获取新的位置Select Case g_intDirectionCase D_UP '向上运动g_udtSnake(SNAKEONE).Snake_CurX =g_udtSnake(SNAKEONE).Snake_OldXg_udtSnake(SNAKEONE).Snake_CurY =g_udtSnake(SNAKEONE).Snake_OldYg_udtSnake(SNAKEONE).Snake_CurY =g_udtSnake(SNAKEONE).Snake_CurY - SNAKEWIDTH Case D_DOWN '向下运动g_udtSnake(SNAKEONE).Snake_CurX =g_udtSnake(SNAKEONE).Snake_OldXg_udtSnake(SNAKEONE).Snake_CurY =g_udtSnake(SNAKEONE).Snake_OldYg_udtSnake(SNAKEONE).Snake_CurY =g_udtSnake(SNAKEONE).Snake_CurY + SNAKEWIDTH Case D_LEFT '向左运动g_udtSnake(SNAKEONE).Snake_CurX =g_udtSnake(SNAKEONE).Snake_OldXg_udtSnake(SNAKEONE).Snake_CurX =g_udtSnake(SNAKEONE).Snake_CurX - SNAKEWIDTH g_udtSnake(SNAKEONE).Snake_CurY =g_udtSnake(SNAKEONE).Snake_OldYCase D_RIGHT '向右运动g_udtSnake(SNAKEONE).Snake_CurX =g_udtSnake(SNAKEONE).Snake_OldXg_udtSnake(SNAKEONE).Snake_CurX =g_udtSnake(SNAKEONE).Snake_CurX + SNAKEWIDTH g_udtSnake(SNAKEONE).Snake_CurY =g_udtSnake(SNAKEONE).Snake_OldYEnd Select'根据新的位置绘制蛇头lngSnakeX = g_udtSnake(SNAKEONE).Snake_CurXlngSnakeY = g_udtSnake(SNAKEONE).Snake_CurYlngSnakeColor = g_udtSnake(SNAKEONE).Snake_ColorMe.picMoveArea.PSet (lngSnakeX, lngSnakeY), lngSnakeColor'移动蛇身体其他部分的位置For i = 2 To g_intSnakeLengthg_udtSnake(i).Snake_CurX = g_udtSnake(i - 1).Snake_OldXg_udtSnake(i).Snake_CurY = g_udtSnake(i - 1).Snake_OldYlngSnakeX = g_udtSnake(i).Snake_CurXlngSnakeY = g_udtSnake(i).Snake_CurYlngSnakeColor = g_udtSnake(i).Snake_ColorMe.picMoveArea.PSet (lngSnakeX, lngSnakeY), lngSnakeColor Next i'更新蛇旧的坐标位置For j = 1 To g_intSnakeLengthg_udtSnake(j).Snake_OldX = g_udtSnake(j).Snake_CurXg_udtSnake(j).Snake_OldY = g_udtSnake(j).Snake_CurYNext j'判断蛇在移动中是否到了禁区而导致游戏失败If m_funMoveForbiddenZone(g_udtSnake(SNAKEONE).Snake_CurX, g_udtSnake(SNAKEONE).Snake_CurY) ThenBeepMsgBox "您的蛇移动到了禁区，游戏失败！", 0 + 16, "BS贪食蛇"Me.tmrSnakeMove.Enabled = FalseMe.tmrGameTime.Enabled = FalseMe.picMoveArea.Visible = FalseExit SubEnd If'判断蛇在移动中是否碰到了自己的身体而导致游戏失败If m_funTouchSnakeBody(g_udtSnake(SNAKEONE).Snake_CurX,g_udtSnake(SNAKEONE).Snake_CurY) ThenBeepMsgBox "您的蛇在移动中碰到了自己的身体，游戏失败！", 0 + 16, "BS 贪食蛇"Me.tmrSnakeMove.Enabled = FalseMe.tmrGameTime.Enabled = FalseMe.picMoveArea.Visible = FalseExit SubEnd If'判断蛇是否吃到了果子If m_funEatPoint(g_udtSnake(SNAKEONE).Snake_CurX,g_udtSnake(SNAKEONE).Snake_CurY) Then'累加玩家的得分并刷新得分显示g_intPlayerScore = g_intPlayerScore + 1Me.lblYourScore.Caption = g_intPlayerScore & "分"Call m_subAddSnake '加长蛇的身体Call m_subGetPoint '获取下一个果子的位置和颜色Else'绘制果子lngPointX = g_udtPoint.Point_XlngPointY = g_udtPoint.Point_YlngPointColor = g_udtPoint.Point_ColorMe.picMoveArea.PSet (lngPointX, lngPointY), lngPointColorEnd IfEnd 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 = 530.Snake_OldY = 530.Snake_Color = vbBlackEnd With'定义蛇身第2节的数据With g_udtSnake(SNAKETWO).Snake_OldX = 530.Snake_OldY = 430.Snake_Color = vbGreenEnd With'定义蛇身第3节的数据With g_udtSnake(SNAKETHREE).Snake_OldX = 530.Snake_OldY = 330.Snake_Color = vbYellowEnd With'定义蛇身第4节的数据With g_udtSnake(SNAKEFOUR).Snake_OldX = 530.Snake_OldY = 230.Snake_Color = vbRedEnd WithMe.picMoveArea.Visible = TrueMe.lblYourScore.Caption = g_intPlayerScore & "分"Me.lblGameTime.Caption = g_lngGameTime & "秒"Me.tmrSnakeMove.Interval = Me.hsbGameSpeed.Value Me.tmrSnakeMove.Enabled = TrueMe.tmrGameTime.Enabled = TrueCall m_subGetPoint '获取第一个果子的位置和颜色End Sub'该私有子过程用于返回获取的果子的位置和颜色信息Private Sub m_subGetPoint()Dim lngRedValue As Long, lngGreenValue As Long, lngBlueValue As LongDim lngPointX As Long, lngPointY As Long, lngPointColor As Long '随机获取果子的颜色lngRedValue = Int((255 - 0 + 1) * Rnd + 0)lngGreenValue = Int((255 - 0 + 1) * Rnd + 0)lngBlueValue = Int((255 - 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 = lngPointColorEnd WithEnd Sub'该私有子过程用于加长蛇的身体Private Sub m_subAddSnake()Dim udtSnakeTemp() As SnakeDim lngSnakeX As Long, lngSnakeY As Long, lngSnakeColor As Long '备份蛇原先身体的数据并使蛇的身体加长ReDim udtSnakeTemp(1 To g_intSnakeLength)For k = 1 To g_intSnakeLengthWith 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_ColorEnd WithNext kg_intSnakeLength = g_intSnakeLength + 1ReDim g_udtSnake(g_intSnakeLength)'将备份蛇身体的数据返回到加长的蛇身数组中For l = 1 To g_intSnakeLength - 1With 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_ColorEnd WithNext l'写入新加入的身体数据Select Case g_intDirectionCase D_UPWith 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_ColorEnd WithCase D_DOWNWith 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_ColorEnd WithCase D_LEFTWith 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_ColorEnd WithCase D_RIGHTWith 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_ColorEnd WithEnd SelectlngSnakeX = g_udtSnake(g_intSnakeLength).Snake_CurXlngSnakeY = g_udtSnake(g_intSnakeLength).Snake_CurYlngSnakeColor = g_udtSnake(g_intSnakeLength).Snake_ColorMe.picMoveArea.PSet (lngSnakeX, lngSnakeY), lngSnakeColorEnd Sub'该自定义函数用于返回运动的蛇是否到达禁区而导致游戏失败Private Function m_funMoveForbiddenZone(SnakeX As Long, SnakeY As Long) As BooleanIf (SnakeX >= FZ_LEFT And SnakeX <= FZ_RIGHT) And (SnakeY >= FZ_TOP And SnakeY <= FZ_BOTTOM) Thenm_funMoveForbiddenZone = FalseElsem_funMoveForbiddenZone = TrueEnd IfEnd Function'该自定义函数用于返回运动的蛇是否碰到自己的身体而导致游戏失败Private Function m_funTouchSnakeBody(SnakeX As Long, SnakeY As Long) As BooleanFor m = 2 To g_intSnakeLengthIf SnakeX = g_udtSnake(m).Snake_CurX And SnakeY =g_udtSnake(m).Snake_CurY Thenm_funTouchSnakeBody = TrueExit ForElsem_funTouchSnakeBody = FalseEnd IfNext mEnd Function'该自定义函数用于返回运动的蛇是否吃到了果子Private Function m_funEatPoint(SnakeX As Long, SnakeY As Long) As BooleanIf Abs(SnakeX - g_udtPoint.Point_X) <= SNAKEWIDTH AndAbs(SnakeY - g_udtPoint.Point_Y) <= SNAKEWIDTH Thenm_funEatPoint = TrueElsem_funEatPoint = FalseEnd IfEnd Function'（API函数调用过程_用以实现无标题窗体的拖动操作）---------------------------------'RleaseCapture函数用以释放鼠标捕获Public Declare Function ReleaseCapture Lib "user32" () As Long'SendMessage函数用作向Windows发送移动窗体的消息Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As _Long, ByVal wMsg As Long, ByVal wParam As Long, IParam As Any) As LongPublic Const WM_SYSCOMMAND = &H112 '声明向Windows发送消息的常量Public Const SC_MOVE = &HF012 '声明控制移动窗体常量'（游戏变量声明部分）-------------------------------------------------------------'定义蛇的数据类型结构Public Type SnakeSnake_OldX As LongSnake_OldY As LongSnake_CurX As LongSnake_CurY As LongSnake_Color As LongEnd Type'定义果子的数据类型结构Public Type PointPoint_X As LongPoint_Y As LongPoint_Color As LongEnd 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。