求用VB编程一贪食蛇小游戏,本人新手,求带详细注释加窗体! vb.net编写的贪吃蛇游戏,带代码的
\u7528VB\u5982\u4f55\u7f16\u5199\u8d2a\u98df\u86c7\u6e38\u620f\u5475\u5475,\u8fd9\u4e2a\u53ef\u7b80\u5355\u4e0d\u4e86, \u4e5f\u4e0d\u662f100\u884c\u4ee5\u5185\u4ee3\u7801\u53ef\u4ee5\u89e3\u51b3\u7684\u5475.
\u8d34\u4e00\u4e2a\u957f\u7684\u5413\u4eba\u7684\u7ed9\u4f60\u770b\u770b\u5427,\u6709\u90e8\u5206\u6ce8\u91ca\u7684:
(\u8d34\u4e0d\u4e0b\u4e86,\u592a\u957f\u4e86..)
=====================
'\u5b9a\u4e49\u86c7\u7684\u8fd0\u52a8\u901f\u5ea6\u679a\u4e3e\u503c
Private Enum tpsSpeed
QUICKLY = 0
SLOWLY = 1
End Enum
'\u5b9a\u4e49\u86c7\u7684\u8fd0\u52a8\u65b9\u5411\u679a\u4e3e\u503c
Private Enum tpsDirection
D_UP = 38
D_DOWN = 40
D_LEFT = 37
D_RIGHT = 39
End Enum
'\u5b9a\u4e49\u8fd0\u52a8\u533a\u57df4\u4e2a\u7981\u533a\u7684\u679a\u4e3e\u503c
Private Enum tpsForbiddenZone
FZ_TOP = 30
FZ_BOTTOM = 5330
FZ_LEFT = 30
FZ_RIGHT = 5730
End Enum
'\u5b9a\u4e49\u86c7\u5934\u53ca\u8eab\u4f53\u521d\u59cb\u5316\u6570\u679a\u4e3e\u503c
Private Enum tpsSnake
SNAKEONE = 1
SNAKETWO = 2
SNAKETHREE = 3
SNAKEFOUR = 4
End Enum
'\u5b9a\u4e49\u86c7\u5bbd\u5ea6\u7684\u5e38\u91cf
Private Const SNAKEWIDTH As Integer = 100
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u663e\u793a\u6e38\u620f\u4fe1\u606f
Private Sub Form_Load()
Me.Show
Me.lblTitle = "BS\u8d2a\u98df\u86c7 \u2014 (\u7248\u672c " & App.Major & "." & App.Minor & "." & App.Revision & ")"
Me.Caption = Me.lblTitle.Caption
frmSplash.Show 1
End Sub
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u4f7f\u7a97\u4f53\u6062\u590d\u539f\u59cb\u5927\u5c0f
Private Sub Form_Resize()
If Me.WindowState 1 Then
Me.Caption = ""
Me.Height = 6405 '\u7a97\u4f53\u9ad8\u5ea6\u4e3a 6405 \u7f07
Me.Width = 8535 '\u7a97\u4f53\u5bbd\u5ea6\u4e3a 8535 \u7f07
Me.Left = (Screen.Width - Width) \ 2
Me.Top = (Screen.Height - Height) \ 2
End If
End Sub
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u91cd\u65b0\u5f00\u59cb\u5f00\u59cb\u6e38\u620f
Private Sub cmdGameStart_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Beep
msg = MsgBox("\u60a8\u786e\u8ba4\u8981\u91cd\u65b0\u5f00\u59cb\u6e38\u620f\u5417\uff1f", 4 + 32, "BS\u8d2a\u98df\u86c7")
If msg = 6 Then Call m_subGameInitialize
End Sub
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u6682\u505c/\u8fd0\u884c\u6e38\u620f
Private Sub chkPause_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Me.chkPause.Caption = "\u6682\u505c\u6e38\u620f(&P)" Then
Me.tmrSnakeMove.Enabled = False
Me.tmrGameTime.Enabled = False
Me.picMoveArea.Enabled = False
Me.lblPauseLab.Visible = True
Me.chkPause.Caption = "\u7ee7\u7eed\u6e38\u620f(&R)"
Else
Me.tmrSnakeMove.Enabled = True
Me.tmrGameTime.Enabled = True
Me.picMoveArea.Enabled = True
Me.lblPauseLab.Visible = False
Me.chkPause.Caption = "\u6682\u505c\u6e38\u620f(&P)"
End If
End Sub
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u663e\u793a\u6e38\u620f\u89c4\u5219
Private Sub cmdGameRules_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Beep
MsgBox " BS\u8d2a\u98df\u86c7\uff1a\u4e00\u4e2a\u89c4\u5219\u6700\u7b80\u5355\u7684\u8da3\u5473\u6e38\u620f\uff0c\u60a8\u5c06\u7528\u952e\u76d8" & Chr(13) & _
"\u4e0a\u76844\u4e2a\u65b9\u5411\u952e\u6765\u63a7\u5236\u86c7\u7684\u8fd0\u52a8\u65b9\u5411\u3002\u5728\u8fd0\u52a8\u8fc7\u7a0b\u4e2d\u86c7" & Chr(13) & _
"\u4e0d\u80fd\u540e\u9000\uff0c\u86c7\u7684\u5934\u90e8\u4e5f\u4e0d\u80fd\u63a5\u89e6\u5230\u8fd0\u52a8\u533a\u57df\u7684\u8fb9\u7ebf\u4ee5\u5916" & Chr(13) & _
"\u548c\u86c7\u81ea\u5df1\u7684\u8eab\u4f53\uff0c\u5426\u5219\u5c31\u6e38\u620f\u5931\u8d25\u3002\u5728\u5403\u6389\u968f\u673a\u51fa\u73b0\u7684" & Chr(13) & _
"\u679c\u5b50\u540e\uff0c\u86c7\u7684\u8eab\u4f53\u4f1a\u53d8\u957f\uff0c\u8d8a\u957f\u96be\u5ea6\u8d8a\u5927\u3002\u795d\u60a8\u597d\u8fd0\uff01\uff01", 0 + 64, "\u6e38\u620f\u89c4\u5219"
End Sub
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u663e\u793a\u6e38\u620f\u5f00\u53d1\u4fe1\u606f
Private Sub cmdAbout_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Beep
MsgBox "BS\u8d2a\u98df\u86c7" & "(V-" & App.Major & "." & App.Minor & "\u7248\u672c)" & Chr(13) & Chr(13) & _
"" & Chr(13) & Chr(13) & _
"\u7531PigheadPrince\u8bbe\u8ba1\u5236\u4f5c" & Chr(13) & _
"CopyRight(C)2002,BestSoft.TCG", 0, "\u5173\u4e8e\u672c\u6e38\u620f"
End Sub
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u9000\u51fa\u6e38\u620f
Private Sub cmdExit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Beep
msg = MsgBox("\u60a8\u8981\u9000\u51fa\u672c\u6e38\u620f\u5417\uff1f", 4 + 32, "BS\u8d2a\u98df\u86c7")
Select Case msg
Case 6
End
Case 7
Me.chkWindowButton(2).Value = 0
Exit Sub
End Select
End Sub
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u62d6\u52a8\u7a97\u4f53_(\u70b9\u51fb\u56fe\u6807)
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
'\u8be5\u5171\u7528\u8fc7\u7a0b\u7528\u4e8e\u5904\u7406\u7a97\u4f53\u63a7\u5236\u6309\u94ae\u7ec4\u7684\u76f8\u5173\u64cd\u4f5c_(\u9501\u5b9a\u3001\u6700\u5c0f\u5316\u3001\u9000\u51fa)
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 '\u9501\u5b9a\u7a97\u4f53
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 '\u6700\u5c0f\u5316
Me.WindowState = 1
Me.chkWindowButton(1).Value = 0
Me.Caption = "BS\u8d2a\u98df\u86c7 \u2014 (V-" & App.Major & "." & App.Minor & "\u7248\u672c)"
Case 2 '\u9000\u51fa
Beep
msg = MsgBox("\u60a8\u8981\u9000\u51fa\u672c\u6e38\u620f\u5417\uff1f", 4 + 32, "BS\u8d2a\u98df\u86c7")
Select Case msg
Case 6
End
Case 7
Me.chkWindowButton(2).Value = 0
Exit Sub
End Select
End Select
End Sub
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u8bbe\u7f6e\u86c7\u8fd0\u52a8\u901f\u5ea6\u7684\u5feb\u6162
Private Sub hsbGameSpeed_Change()
Me.tmrSnakeMove.Interval = Me.hsbGameSpeed.Value
End Sub
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u901a\u8fc7\u952e\u76d8\u7684\u65b9\u5411\u952e\u6539\u53d8\u86c7\u7684\u8fd0\u52a8\u65b9\u5411
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
'\u8be5\u8ba1\u65f6\u5faa\u73af\u8fc7\u7a0b\u7528\u4e8e\u8ba1\u7b97\u6e38\u620f\u8017\u8d39\u7684\u79d2\u6570\u5e76\u663e\u793a
Private Sub tmrGameTime_Timer()
g_lngGameTime = g_lngGameTime + 1
Me.lblGameTime.Caption = g_lngGameTime & "\u79d2"
End Sub
'\u8be5\u8ba1\u65f6\u5faa\u73af\u8fc7\u7a0b\u7528\u4e8e\u63a7\u5236\u86c7\u7684\u884c\u52a8\u8f68\u8ff9
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
'\u786e\u8ba4\u86c7\u5934\u7684\u8fd0\u52a8\u65b9\u5411\u5e76\u83b7\u53d6\u65b0\u7684\u4f4d\u7f6e
Select Case g_intDirection
Case D_UP '\u5411\u4e0a\u8fd0\u52a8
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 '\u5411\u4e0b\u8fd0\u52a8
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 '\u5411\u5de6\u8fd0\u52a8
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 '\u5411\u53f3\u8fd0\u52a8
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
'\u6839\u636e\u65b0\u7684\u4f4d\u7f6e\u7ed8\u5236\u86c7\u5934
lngSnakeX = g_udtSnake(SNAKEONE).Snake_CurX
lngSnakeY = g_udtSnake(SNAKEONE).Snake_CurY
lngSnakeColor = g_udtSnake(SNAKEONE).Snake_Color
Me.picMoveArea.PSet (lngSnakeX, lngSnakeY), lngSnakeColor
'\u79fb\u52a8\u86c7\u8eab\u4f53\u5176\u4ed6\u90e8\u5206\u7684\u4f4d\u7f6e
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
'\u66f4\u65b0\u86c7\u65e7\u7684\u5750\u6807\u4f4d\u7f6e
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
'\u5224\u65ad\u86c7\u5728\u79fb\u52a8\u4e2d\u662f\u5426\u5230\u4e86\u7981\u533a\u800c\u5bfc\u81f4\u6e38\u620f\u5931\u8d25
If m_funMoveForbiddenZone(g_udtSnake(SNAKEONE).Snake_CurX, g_udtSnake(SNAKEONE).Snake_CurY) Then
Beep
MsgBox "\u60a8\u7684\u86c7\u79fb\u52a8\u5230\u4e86\u7981\u533a\uff0c\u6e38\u620f\u5931\u8d25\uff01", 0 + 16, "BS\u8d2a\u98df\u86c7"
Me.tmrSnakeMove.Enabled = False
Me.tmrGameTime.Enabled = False
Me.picMoveArea.Visible = False
Exit Sub
End If
'\u5224\u65ad\u86c7\u5728\u79fb\u52a8\u4e2d\u662f\u5426\u78b0\u5230\u4e86\u81ea\u5df1\u7684\u8eab\u4f53\u800c\u5bfc\u81f4\u6e38\u620f\u5931\u8d25
If m_funTouchSnakeBody(g_udtSnake(SNAKEONE).Snake_CurX, g_udtSnake(SNAKEONE).Snake_CurY) Then
Beep
MsgBox "\u60a8\u7684\u86c7\u5728\u79fb\u52a8\u4e2d\u78b0\u5230\u4e86\u81ea\u5df1\u7684\u8eab\u4f53\uff0c\u6e38\u620f\u5931\u8d25\uff01", 0 + 16, "BS\u8d2a\u98df\u86c7"
Me.tmrSnakeMove.Enabled = False
Me.tmrGameTime.Enabled = False
Me.picMoveArea.Visible = False
Exit Sub
End If
'\u5224\u65ad\u86c7\u662f\u5426\u5403\u5230\u4e86\u679c\u5b50
If m_funEatPoint(g_udtSnake(SNAKEONE).Snake_CurX, g_udtSnake(SNAKEONE).Snake_CurY) Then
'\u7d2f\u52a0\u73a9\u5bb6\u7684\u5f97\u5206\u5e76\u5237\u65b0\u5f97\u5206\u663e\u793a
g_intPlayerScore = g_intPlayerScore + 1
Me.lblYourScore.Caption = g_intPlayerScore & "\u5206"
Call m_subAddSnake '\u52a0\u957f\u86c7\u7684\u8eab\u4f53
Call m_subGetPoint '\u83b7\u53d6\u4e0b\u4e00\u4e2a\u679c\u5b50\u7684\u4f4d\u7f6e\u548c\u989c\u8272
Else
'\u7ed8\u5236\u679c\u5b50
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
'\u8be5\u79c1\u6709\u5b50\u8fc7\u7a0b\u7528\u4e8e\u521d\u59cb\u5316\u6e38\u620f
Private Sub m_subGameInitialize()
Erase g_udtSnake '\u6e05\u7a7a\u86c7\u7684\u7ed3\u6784\u6570\u7ec4
g_intPlayerScore = 0 '\u6e05\u7a7a\u73a9\u5bb6\u7684\u5f97\u5206
g_lngGameTime = 0 '\u6e05\u7a7a\u6e38\u620f\u8017\u8d39\u7684\u79d2\u6570
g_intDirection = D_DOWN '\u8bbe\u5b9a\u86c7\u7684\u521d\u59cb\u8fd0\u52a8\u65b9\u5411\u4e3a\u4e0b
g_intSnakeLength = 4 '\u8bbe\u5b9a\u86c7\u7684\u521d\u59cb\u957f\u5ea6
ReDim g_udtSnake(1 To g_intSnakeLength) '\u91cd\u65b0\u5b9a\u4e49\u86c7\u7684\u957f\u5ea6
'\u5b9a\u4e49\u86c7\u5934\u90e8\u7684\u6570\u636e
With g_udtSnake(SNAKEONE)
.Snake_OldX = 530
.Snake_OldY = 530
.Snake_Color = vbBlack
End With
'\u5b9a\u4e49\u86c7\u8eab\u7b2c2\u8282\u7684\u6570\u636e
With g_udtSnake(SNAKETWO)
.Snake_OldX = 530
.Snake_OldY = 430
.Snake_Color = vbGreen
End With
'\u5b9a\u4e49\u86c7\u8eab\u7b2c3\u8282\u7684\u6570\u636e
With g_udtSnake(SNAKETHREE)
.Snake_OldX = 530
.Snake_OldY = 330
.Snake_Color = vbYellow
End With
'\u5b9a\u4e49\u86c7\u8eab\u7b2c4\u8282\u7684\u6570\u636e
With g_udtSnake(SNAKEFOUR)
.Snake_OldX = 530
.Snake_OldY = 230
.Snake_Color = vbRed
End With
Me.picMoveArea.Visible = True
Me.lblYourScore.Caption = g_intPlayerScore & "\u5206"
Me.lblGameTime.Caption = g_lngGameTime & "\u79d2"
Me.tmrSnakeMove.Interval = Me.hsbGameSpeed.Value
Me.tmrSnakeMove.Enabled = True
Me.tmrGameTime.Enabled = True
Call m_subGetPoint '\u83b7\u53d6\u7b2c\u4e00\u4e2a\u679c\u5b50\u7684\u4f4d\u7f6e\u548c\u989c\u8272
End Sub
'\u8be5\u79c1\u6709\u5b50\u8fc7\u7a0b\u7528\u4e8e\u8fd4\u56de\u83b7\u53d6\u7684\u679c\u5b50\u7684\u4f4d\u7f6e\u548c\u989c\u8272\u4fe1\u606f
Private Sub m_subGetPoint()
Dim lngRedValue As Long, lngGreenValue As Long, lngBlueValue As Long
Dim lngPointX As Long, lngPointY As Long, lngPointColor As Long
'\u968f\u673a\u83b7\u53d6\u679c\u5b50\u7684\u989c\u8272
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)
'\u968f\u673a\u83b7\u53d6\u679c\u5b50\u7684\u4f4d\u7f6e
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
'\u8bbe\u7f6e\u51fd\u6570\u8fd4\u56de\u503c
With g_udtPoint
.Point_X = lngPointX
.Point_Y = lngPointY
.Point_Color = lngPointColor
End With
End Sub
'\u8be5\u79c1\u6709\u5b50\u8fc7\u7a0b\u7528\u4e8e\u52a0\u957f\u86c7\u7684\u8eab\u4f53
Private Sub m_subAddSnake()
Dim udtSnakeTemp() As Snake
Dim lngSnakeX As Long, lngSnakeY As Long, lngSnakeColor As Long
'\u5907\u4efd\u86c7\u539f\u5148\u8eab\u4f53\u7684\u6570\u636e\u5e76\u4f7f\u86c7\u7684\u8eab\u4f53\u52a0\u957f
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)
'\u5c06\u5907\u4efd\u86c7\u8eab\u4f53\u7684\u6570\u636e\u8fd4\u56de\u5230\u52a0\u957f\u7684\u86c7\u8eab\u6570\u7ec4\u4e2d
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
'\u5199\u5165\u65b0\u52a0\u5165\u7684\u8eab\u4f53\u6570\u636e
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
'\u8be5\u81ea\u5b9a\u4e49\u51fd\u6570\u7528\u4e8e\u8fd4\u56de\u8fd0\u52a8\u7684\u86c7\u662f\u5426\u5230\u8fbe\u7981\u533a\u800c\u5bfc\u81f4\u6e38\u620f\u5931\u8d25
Private Function m_funMoveForbiddenZone(SnakeX As Long, SnakeY As Long) As Boolean
If (SnakeX >= FZ_LEFT And SnakeX = FZ_TOP And SnakeY <= FZ_BOTTOM) Then
m_funMoveForbiddenZone = False
Else
m_funMoveForbiddenZone = True
End If
End Function
'\u8be5\u81ea\u5b9a\u4e49\u51fd\u6570\u7528\u4e8e\u8fd4\u56de\u8fd0\u52a8\u7684\u86c7\u662f\u5426\u78b0\u5230\u81ea\u5df1\u7684\u8eab\u4f53\u800c\u5bfc\u81f4\u6e38\u620f\u5931\u8d25
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
'\u8be5\u81ea\u5b9a\u4e49\u51fd\u6570\u7528\u4e8e\u8fd4\u56de\u8fd0\u52a8\u7684\u86c7\u662f\u5426\u5403\u5230\u4e86\u679c\u5b50
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
'\uff08API\u51fd\u6570\u8c03\u7528\u8fc7\u7a0b_\u7528\u4ee5\u5b9e\u73b0\u65e0\u6807\u9898\u7a97\u4f53\u7684\u62d6\u52a8\u64cd\u4f5c\uff09---------------------------------
'RleaseCapture\u51fd\u6570\u7528\u4ee5\u91ca\u653e\u9f20\u6807\u6355\u83b7
Public Declare Function ReleaseCapture Lib "user32" () As Long
'SendMessage\u51fd\u6570\u7528\u4f5c\u5411Windows\u53d1\u9001\u79fb\u52a8\u7a97\u4f53\u7684\u6d88\u606f
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As _
Long, ByVal wMsg As Long, ByVal wParam As Long, IParam As Any) As Long
Public Const WM_SYSCOMMAND = &H112 '\u58f0\u660e\u5411Windows\u53d1\u9001\u6d88\u606f\u7684\u5e38\u91cf
Public Const SC_MOVE = &HF012 '\u58f0\u660e\u63a7\u5236\u79fb\u52a8\u7a97\u4f53\u5e38\u91cf
'\uff08\u6e38\u620f\u53d8\u91cf\u58f0\u660e\u90e8\u5206\uff09-------------------------------------------------------------
'\u5b9a\u4e49\u86c7\u7684\u6570\u636e\u7c7b\u578b\u7ed3\u6784
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
'\u5b9a\u4e49\u679c\u5b50\u7684\u6570\u636e\u7c7b\u578b\u7ed3\u6784
Public Type Point
Point_X As Long
Point_Y As Long
Point_Color As Long
End Type
'\u5b9a\u4e49\u86c7\u7684\u52a8\u6001\u6570\u7ec4
Public g_udtSnake() As Snake
'\u5b9a\u4e49\u679c\u5b50
Public g_udtPoint As Point
'\u5b9a\u4e49\u86c7\u7684\u957f\u5ea6
Public g_intSnakeLength
\u9700\u7528VB\u5b9e\u73b0\uff0c\u4ee3\u7801\u5982\u4e0b
'\u5b9a\u4e49\u86c7\u7684\u8fd0\u52a8\u901f\u5ea6\u679a\u4e3e\u503c
Private Enum tpsSpeed
QUICKLY = 0
SLOWLY = 1
End Enum
'\u5b9a\u4e49\u86c7\u7684\u8fd0\u52a8\u65b9\u5411\u679a\u4e3e\u503c
Private Enum tpsDirection
D_UP = 38
D_DOWN = 40
D_LEFT = 37
D_RIGHT = 39
End Enum
'\u5b9a\u4e49\u8fd0\u52a8\u533a\u57df4\u4e2a\u7981\u533a\u7684\u679a\u4e3e\u503c
Private Enum tpsForbiddenZone
FZ_TOP = 30
FZ_BOTTOM = 5330
FZ_LEFT = 30
FZ_RIGHT = 5730
End Enum
'\u5b9a\u4e49\u86c7\u5934\u53ca\u8eab\u4f53\u521d\u59cb\u5316\u6570\u679a\u4e3e\u503c
Private Enum tpsSnake
SNAKEONE = 1
SNAKETWO = 2
SNAKETHREE = 3
SNAKEFOUR = 4
End Enum
'\u5b9a\u4e49\u86c7\u5bbd\u5ea6\u7684\u5e38\u91cf
Private Const SNAKEWIDTH As Integer = 100
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u663e\u793a\u6e38\u620f\u4fe1\u606f
Private Sub Form_Load()
Me.Show
Me.lblTitle = "BS\u8d2a\u98df\u86c7 \u2014 (\u7248\u672c " & App.Major & "." & App.Minor & "." & App.Revision & ")"
Me.Caption = Me.lblTitle.Caption
frmSplash.Show 1
End Sub
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u4f7f\u7a97\u4f53\u6062\u590d\u539f\u59cb\u5927\u5c0f
Private Sub Form_Resize()
If Me.WindowState 1 Then
Me.Caption = ""
Me.Height = 6405 '\u7a97\u4f53\u9ad8\u5ea6\u4e3a 6405 \u7f07
Me.Width = 8535 '\u7a97\u4f53\u5bbd\u5ea6\u4e3a 8535 \u7f07
Me.Left = (Screen.Width - Width) \ 2
Me.Top = (Screen.Height - Height) \ 2
End If
End Sub
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u91cd\u65b0\u5f00\u59cb\u5f00\u59cb\u6e38\u620f
Private Sub cmdGameStart_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Beep
msg = MsgBox("\u60a8\u786e\u8ba4\u8981\u91cd\u65b0\u5f00\u59cb\u6e38\u620f\u5417\uff1f", 4 + 32, "BS\u8d2a\u98df\u86c7")
If msg = 6 Then Call m_subGameInitialize
End Sub
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u6682\u505c/\u8fd0\u884c\u6e38\u620f
Private Sub chkPause_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Me.chkPause.Caption = "\u6682\u505c\u6e38\u620f(&P)" Then
Me.tmrSnakeMove.Enabled = False
Me.tmrGameTime.Enabled = False
Me.picMoveArea.Enabled = False
Me.lblPauseLab.Visible = True
Me.chkPause.Caption = "\u7ee7\u7eed\u6e38\u620f(&R)"
Else
Me.tmrSnakeMove.Enabled = True
Me.tmrGameTime.Enabled = True
Me.picMoveArea.Enabled = True
Me.lblPauseLab.Visible = False
Me.chkPause.Caption = "\u6682\u505c\u6e38\u620f(&P)"
End If
End Sub
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u663e\u793a\u6e38\u620f\u89c4\u5219
Private Sub cmdGameRules_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Beep
MsgBox " BS\u8d2a\u98df\u86c7\uff1a\u4e00\u4e2a\u89c4\u5219\u6700\u7b80\u5355\u7684\u8da3\u5473\u6e38\u620f\uff0c\u60a8\u5c06\u7528\u952e\u76d8" & Chr(13) & _
"\u4e0a\u76844\u4e2a\u65b9\u5411\u952e\u6765\u63a7\u5236\u86c7\u7684\u8fd0\u52a8\u65b9\u5411\u3002\u5728\u8fd0\u52a8\u8fc7\u7a0b\u4e2d\u86c7" & Chr(13) & _
"\u4e0d\u80fd\u540e\u9000\uff0c\u86c7\u7684\u5934\u90e8\u4e5f\u4e0d\u80fd\u63a5\u89e6\u5230\u8fd0\u52a8\u533a\u57df\u7684\u8fb9\u7ebf\u4ee5\u5916" & Chr(13) & _
"\u548c\u86c7\u81ea\u5df1\u7684\u8eab\u4f53\uff0c\u5426\u5219\u5c31\u6e38\u620f\u5931\u8d25\u3002\u5728\u5403\u6389\u968f\u673a\u51fa\u73b0\u7684" & Chr(13) & _
"\u679c\u5b50\u540e\uff0c\u86c7\u7684\u8eab\u4f53\u4f1a\u53d8\u957f\uff0c\u8d8a\u957f\u96be\u5ea6\u8d8a\u5927\u3002\u795d\u60a8\u597d\u8fd0\uff01\uff01", 0 + 64, "\u6e38\u620f\u89c4\u5219"
End Sub
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u663e\u793a\u6e38\u620f\u5f00\u53d1\u4fe1\u606f
Private Sub cmdAbout_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Beep
MsgBox "BS\u8d2a\u98df\u86c7" & "(V-" & App.Major & "." & App.Minor & "\u7248\u672c)" & Chr(13) & Chr(13) & _
"" & Chr(13) & Chr(13) & _
"\u7531PigheadPrince\u8bbe\u8ba1\u5236\u4f5c" & Chr(13) & _
"CopyRight(C)2002,BestSoft.TCG", 0, "\u5173\u4e8e\u672c\u6e38\u620f"
End Sub
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u9000\u51fa\u6e38\u620f
Private Sub cmdExit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Beep
msg = MsgBox("\u60a8\u8981\u9000\u51fa\u672c\u6e38\u620f\u5417\uff1f", 4 + 32, "BS\u8d2a\u98df\u86c7")
Select Case msg
Case 6
End
Case 7
Me.chkWindowButton(2).Value = 0
Exit Sub
End Select
End Sub
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u62d6\u52a8\u7a97\u4f53_(\u70b9\u51fb\u56fe\u6807)
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
'\u8be5\u5171\u7528\u8fc7\u7a0b\u7528\u4e8e\u5904\u7406\u7a97\u4f53\u63a7\u5236\u6309\u94ae\u7ec4\u7684\u76f8\u5173\u64cd\u4f5c_(\u9501\u5b9a\u3001\u6700\u5c0f\u5316\u3001\u9000\u51fa)
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 '\u9501\u5b9a\u7a97\u4f53
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 '\u6700\u5c0f\u5316
Me.WindowState = 1
Me.chkWindowButton(1).Value = 0
Me.Caption = "BS\u8d2a\u98df\u86c7 \u2014 (V-" & App.Major & "." & App.Minor & "\u7248\u672c)"
Case 2 '\u9000\u51fa
Beep
msg = MsgBox("\u60a8\u8981\u9000\u51fa\u672c\u6e38\u620f\u5417\uff1f", 4 + 32, "BS\u8d2a\u98df\u86c7")
Select Case msg
Case 6
End
Case 7
Me.chkWindowButton(2).Value = 0
Exit Sub
End Select
End Select
End Sub
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u8bbe\u7f6e\u86c7\u8fd0\u52a8\u901f\u5ea6\u7684\u5feb\u6162
Private Sub hsbGameSpeed_Change()
Me.tmrSnakeMove.Interval = Me.hsbGameSpeed.Value
End Sub
'\u8be5\u8fc7\u7a0b\u7528\u4e8e\u901a\u8fc7\u952e\u76d8\u7684\u65b9\u5411\u952e\u6539\u53d8\u86c7\u7684\u8fd0\u52a8\u65b9\u5411
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
'\u8be5\u8ba1\u65f6\u5faa\u73af\u8fc7\u7a0b\u7528\u4e8e\u8ba1\u7b97\u6e38\u620f\u8017\u8d39\u7684\u79d2\u6570\u5e76\u663e\u793a
Private Sub tmrGameTime_Timer()
g_lngGameTime = g_lngGameTime + 1
Me.lblGameTime.Caption = g_lngGameTime & "\u79d2"
End Sub
'\u8be5\u8ba1\u65f6\u5faa\u73af\u8fc7\u7a0b\u7528\u4e8e\u63a7\u5236\u86c7\u7684\u884c\u52a8\u8f68\u8ff9
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
'\u786e\u8ba4\u86c7\u5934\u7684\u8fd0\u52a8\u65b9\u5411\u5e76\u83b7\u53d6\u65b0\u7684\u4f4d\u7f6e
Select Case g_intDirection
Case D_UP '\u5411\u4e0a\u8fd0\u52a8
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 '\u5411\u4e0b\u8fd0\u52a8
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 '\u5411\u5de6\u8fd0\u52a8
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 '\u5411\u53f3\u8fd0\u52a8
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
'\u6839\u636e\u65b0\u7684\u4f4d\u7f6e\u7ed8\u5236\u86c7\u5934
lngSnakeX = g_udtSnake(SNAKEONE).Snake_CurX
lngSnakeY = g_udtSnake(SNAKEONE).Snake_CurY
lngSnakeColor = g_udtSnake(SNAKEONE).Snake_Color
Me.picMoveArea.PSet (lngSnakeX, lngSnakeY), lngSnakeColor
'\u79fb\u52a8\u86c7\u8eab\u4f53\u5176\u4ed6\u90e8\u5206\u7684\u4f4d\u7f6e
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
'\u66f4\u65b0\u86c7\u65e7\u7684\u5750\u6807\u4f4d\u7f6e
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
'\u5224\u65ad\u86c7\u5728\u79fb\u52a8\u4e2d\u662f\u5426\u5230\u4e86\u7981\u533a\u800c\u5bfc\u81f4\u6e38\u620f\u5931\u8d25
If m_funMoveForbiddenZone(g_udtSnake(SNAKEONE).Snake_CurX, g_udtSnake(SNAKEONE).Snake_CurY) Then
Beep
MsgBox "\u60a8\u7684\u86c7\u79fb\u52a8\u5230\u4e86\u7981\u533a\uff0c\u6e38\u620f\u5931\u8d25\uff01", 0 + 16, "BS\u8d2a\u98df\u86c7"
Me.tmrSnakeMove.Enabled = False
Me.tmrGameTime.Enabled = False
Me.picMoveArea.Visible = False
Exit Sub
End If
'\u5224\u65ad\u86c7\u5728\u79fb\u52a8\u4e2d\u662f\u5426\u78b0\u5230\u4e86\u81ea\u5df1\u7684\u8eab\u4f53\u800c\u5bfc\u81f4\u6e38\u620f\u5931\u8d25
If m_funTouchSnakeBody(g_udtSnake(SNAKEONE).Snake_CurX, g_udtSnake(SNAKEONE).Snake_CurY) Then
Beep
MsgBox "\u60a8\u7684\u86c7\u5728\u79fb\u52a8\u4e2d\u78b0\u5230\u4e86\u81ea\u5df1\u7684\u8eab\u4f53\uff0c\u6e38\u620f\u5931\u8d25\uff01", 0 + 16, "BS\u8d2a\u98df\u86c7"
Me.tmrSnakeMove.Enabled = False
Me.tmrGameTime.Enabled = False
Me.picMoveArea.Visible = False
Exit Sub
End If
'\u5224\u65ad\u86c7\u662f\u5426\u5403\u5230\u4e86\u679c\u5b50
If m_funEatPoint(g_udtSnake(SNAKEONE).Snake_CurX, g_udtSnake(SNAKEONE).Snake_CurY) Then
'\u7d2f\u52a0\u73a9\u5bb6\u7684\u5f97\u5206\u5e76\u5237\u65b0\u5f97\u5206\u663e\u793a
g_intPlayerScore = g_intPlayerScore + 1
Me.lblYourScore.Caption = g_intPlayerScore & "\u5206"
Call m_subAddSnake '\u52a0\u957f\u86c7\u7684\u8eab\u4f53
Call m_subGetPoint '\u83b7\u53d6\u4e0b\u4e00\u4e2a\u679c\u5b50\u7684\u4f4d\u7f6e\u548c\u989c\u8272
Else
'\u7ed8\u5236\u679c\u5b50
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
'\u8be5\u79c1\u6709\u5b50\u8fc7\u7a0b\u7528\u4e8e\u521d\u59cb\u5316\u6e38\u620f
Private Sub m_subGameInitialize()
Erase g_udtSnake '\u6e05\u7a7a\u86c7\u7684\u7ed3\u6784\u6570\u7ec4
g_intPlayerScore = 0 '\u6e05\u7a7a\u73a9\u5bb6\u7684\u5f97\u5206
g_lngGameTime = 0 '\u6e05\u7a7a\u6e38\u620f\u8017\u8d39\u7684\u79d2\u6570
g_intDirection = D_DOWN '\u8bbe\u5b9a\u86c7\u7684\u521d\u59cb\u8fd0\u52a8\u65b9\u5411\u4e3a\u4e0b
g_intSnakeLength = 4 '\u8bbe\u5b9a\u86c7\u7684\u521d\u59cb\u957f\u5ea6
ReDim g_udtSnake(1 To g_intSnakeLength) '\u91cd\u65b0\u5b9a\u4e49\u86c7\u7684\u957f\u5ea6
'\u5b9a\u4e49\u86c7\u5934\u90e8\u7684\u6570\u636e
With g_udtSnake(SNAKEONE)
.Snake_OldX = 530
.Snake_OldY = 530
.Snake_Color = vbBlack
End With
'\u5b9a\u4e49\u86c7\u8eab\u7b2c2\u8282\u7684\u6570\u636e
With g_udtSnake(SNAKETWO)
.Snake_OldX = 530
.Snake_OldY = 430
.Snake_Color = vbGreen
End With
'\u5b9a\u4e49\u86c7\u8eab\u7b2c3\u8282\u7684\u6570\u636e
With g_udtSnake(SNAKETHREE)
.Snake_OldX = 530
.Snake_OldY = 330
.Snake_Color = vbYellow
End With
'\u5b9a\u4e49\u86c7\u8eab\u7b2c4\u8282\u7684\u6570\u636e
With g_udtSnake(SNAKEFOUR)
.Snake_OldX = 530
.Snake_OldY = 230
.Snake_Color = vbRed
End With
Me.picMoveArea.Visible = True
Me.lblYourScore.Caption = g_intPlayerScore & "\u5206"
Me.lblGameTime.Caption = g_lngGameTime & "\u79d2"
Me.tmrSnakeMove.Interval = Me.hsbGameSpeed.Value
Me.tmrSnakeMove.Enabled = True
Me.tmrGameTime.Enabled = True
Call m_subGetPoint '\u83b7\u53d6\u7b2c\u4e00\u4e2a\u679c\u5b50\u7684\u4f4d\u7f6e\u548c\u989c\u8272
End Sub
这个代码不要任何控件,你只需要把以下代码复制到你的窗体代码中就行了,代码很简单,相信你能看懂!仅仅用了一个结构(ShenTi)一个数组(ZhuangTai(23, 23) As Long) 一个变量(GFangXiang)
代码中自动生成了Timer1,Label1控件。以及几个函数(Randomize,Circle,Line,Erase...) 相信这些对于你来说很简单,只是没想到用这些方法来实现而已,现在你开始看看效果吧!
代码如下:
'贪吃蛇代码(无控件、全代码)
Private WithEvents Timer1 As Timer
Private WithEvents Label1 As Label
Dim GFangXiang As Boolean
Dim HWB As Single
Dim She() As ShenTi
Dim X As Long, Y As Long
Dim ZhuangTai(23, 23) As Long
Private Type ShenTi
F As Long
X As Long
Y As Long
End Type
'按键反应 ←↑↓→
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim C As Long
If KeyCode = 27 Then End 'ESC退出
If KeyCode = 32 Then
If Timer1.Enabled = True Then '空格暂停
Timer1.Enabled = False
Label1.Visible = True
Else '空格开始
Timer1.Enabled = True
Label1.Visible = False
End If
End If
C = UBound(She)
If GFangXiang = True Then Exit Sub
Select Case KeyCode
Case 37 '←
If She(C).F = 2 Then Exit Sub
She(C).F = 0
GFangXiang = True
Case 38 '↑
If She(C).F = 3 Then Exit Sub
She(C).F = 1
GFangXiang = True
Case 39 '↑
If She(C).F = 0 Then Exit Sub
She(C).F = 2
GFangXiang = True
Case 40 '→
If She(C).F = 1 Then Exit Sub
She(C).F = 3
GFangXiang = True
End Select
End Sub
Private Sub Form_Load()
Me.AutoRedraw = True
Me.BackColor = &HC000&
Me.FillColor = 255
Me.FillStyle = 0
Me.WindowState = 2
Set Timer1 = Controls.Add("VB.Timer", "Timer1")
Set Label1 = Controls.Add("VB.Label", "Label1")
Label1.AutoSize = True
Label1.BackStyle = 0
Label1 = "暂停"
Label1.ForeColor = RGB(255, 255, 0)
Label1.FontSize = 50
ChuShiHua '初始化
End Sub
Private Sub Form_Resize()
On Error GoTo 1:
With Me
If .WindowState <> 1 Then
.Cls
.ScaleMode = 3
HWB = .ScaleHeight / .ScaleWidth
.ScaleWidth = 24
.ScaleHeight = 24
Label1.Move (Me.ScaleWidth - Label1.Width) / 2, (Me.ScaleHeight - Label1.Height) / 2
HuaTu
Me.Line (X, Y)-(X + 1, Y + 1), RGB(255, 255, 0), BF
End If
End With
1:
End Sub
Private Sub Timer1_Timer()
Dim C As Long, I As Long
On Error GoTo 2:
QingChu '清图
C = UBound(She)
Select Case She(C).F
Case 0
If ZhuangTai(She(C).X - 1, She(C).Y) = 2 Then
C = C + 1
ReDim Preserve She(C)
She(C).F = She(C - 1).F
She(C).X = She(C - 1).X - 1
She(C).Y = She(C - 1).Y
ChanShengShiWu
GoTo 1:
ElseIf ZhuangTai(She(C).X - 1, She(C).Y) = 1 Then
GoTo 2:
End If
Case 1
If ZhuangTai(She(C).X, She(C).Y - 1) = 2 Then
C = C + 1
ReDim Preserve She(C)
She(C).F = She(C - 1).F
She(C).X = She(C - 1).X
She(C).Y = She(C - 1).Y - 1
ChanShengShiWu
GoTo 1:
ElseIf ZhuangTai(She(C).X, She(C).Y - 1) = 1 Then
GoTo 2:
End If
Case 2
If ZhuangTai(She(C).X + 1, She(C).Y) = 2 Then
C = C + 1
ReDim Preserve She(C)
She(C).F = She(C - 1).F
She(C).X = She(C - 1).X + 1
She(C).Y = She(C - 1).Y
ChanShengShiWu
GoTo 1:
ElseIf ZhuangTai(She(C).X + 1, She(C).Y) = 1 Then
GoTo 2:
End If
Case 3
If ZhuangTai(She(C).X, She(C).Y + 1) = 2 Then
C = C + 1
ReDim Preserve She(C)
She(C).F = She(C - 1).F
She(C).X = She(C - 1).X
She(C).Y = She(C - 1).Y + 1
ChanShengShiWu
GoTo 1:
ElseIf ZhuangTai(She(C).X, She(C).Y + 1) = 1 Then
GoTo 2:
End If
End Select
ZhuangTai(She(0).X, She(0).Y) = 0
For I = 0 To C
Select Case She(I).F
Case 0
She(I).X = She(I).X - 1
Case 1
She(I).Y = She(I).Y - 1
Case 2
She(I).X = She(I).X + 1
Case 3
She(I).Y = She(I).Y + 1
End Select
Next
TiaoZheng
1:
GFangXiang = False
ZhuangTai(She(C).X, She(C).Y) = 1
HuaTu
Exit Sub
2: '游戏结束
If MsgBox("得分:" & UBound(She) - 2 & "分 " & vbCrLf & "游戏结束,点“是”重新开始游戏,点“否”", vbYesNo, "贪吃蛇") = vbYes Then
ChuShiHua
Else
End
End If
End Sub
'初始化
Private Sub ChuShiHua()
Me.Cls
Timer1.Enabled = True
Timer1.Interval = 50
Erase ZhuangTai
ReDim She(2)
She(0).F = 2
She(0).X = 9
She(0).Y = 11
ZhuangTai(9, 11) = 1
She(1).F = 2
She(1).X = 10
She(1).Y = 11
ZhuangTai(10, 11) = 1
She(2).F = 2
She(2).X = 11
She(2).Y = 11
ZhuangTai(11, 11) = 1
HuaTu '画图
ChanShengShiWu
End Sub
'清图
Private Sub QingChu()
Dim I As Long
For I = 0 To UBound(She)
Me.Line (She(I).X, She(I).Y)-(She(I).X + 1, She(I).Y + 1), Me.BackColor, BF
Next
End Sub
'画图 蛇
Private Sub HuaTu()
Dim I As Long
For I = 0 To UBound(She)
Me.Circle (She(I).X + 0.5, She(I).Y + 0.5), 0.49, RGB(255, 255, 0), , , HWB
Next
End Sub
Private Sub TiaoZheng()
Dim I As Long
For I = 0 To UBound(She) - 1
She(I).F = She(I + 1).F
Next
End Sub
'随机产生食物
Private Sub ChanShengShiWu()
Randomize Timer
1:
X = Int(Rnd * 24)
Y = Int(Rnd * 24)
If ZhuangTai(X, Y) > 0 Then GoTo 1:
ZhuangTai(X, Y) = 2
Me.Line (X, Y)-(X + 1, Y + 1), RGB(255, 255, 0), BF
End Sub
绛旓細浠g爜濡備笅锛 '璐悆铔浠g爜(鏃犳帶浠躲佸叏浠g爜锛塒rivate WithEvents Timer1 As Timer Private WithEvents Label1 As Label Dim GFangXiang As Boolean Dim HWB As Single Dim She() As ShenTi Dim X As Long, Y As Long Dim ZhuangTai(23, 23) As Long Private Type ShenTi F As Long X As Long...
绛旓細MsgBox " BS璐铔:涓涓鍒欐渶绠鍗曠殑瓒e懗娓告垙,鎮ㄥ皢鐢ㄩ敭鐩" & Chr(13) & _ "涓婄殑4涓柟鍚戦敭鏉ユ帶鍒惰泧鐨勮繍鍔ㄦ柟鍚戙傚湪杩愬姩杩囩▼涓泧" & Chr(13) & _ "涓嶈兘鍚庨,铔囩殑澶撮儴涔熶笉鑳芥帴瑙﹀埌杩愬姩鍖哄煙鐨勮竟绾夸互澶" & Chr(13) & _ "鍜岃泧鑷繁鐨勮韩浣,鍚﹀垯灏辨父鎴忓け璐ャ傚湪鍚冩帀闅忔満鍑虹幇鐨" & Chr(13) & _ "鏋滃瓙...
绛旓細1銆佸悜涓婂墠杩涚殑鏃跺欙紝瀵逛唬鐮佽繘琛屼竴涓瑙c2銆佸悜涓婂墠杩涙椂锛寈鍧愭爣涓嶅姩锛寉鍧愭爣-1锛濡傛灉涓嬩竴涓湁椋熺墿 涓嬩竴涓綅缃殑鍧愭爣鍜岄鐗╃殑鍧愭爣鐩稿悓銆傛妸椋熺墿杞寲鎴愯泧鐨勮韩浣撱3銆佸鏋滆泧鍚冨埌浜嗛鐗╋紝灏卞紑濮嬪姞閫燂紝骞朵笖椋熺墿鐨勫緱鍒+2銆4銆佸鏋滄病鏈夊悆鍒伴鐗╋紝铔囧彲浠ユ甯稿線鍓嶈蛋锛屾仮澶嶅師鏉ョ殑鏂瑰潡銆5銆佸悜涓嬪墠杩涙椂锛寈鍧愭爣涓...
绛旓細Private Type ss'杩欐槸鎴戜互鍓嶅啓鐨勭▼搴忥紝甯屾湜鑳藉府鍒颁綘锛屾坊鍔犱竴涓悕涓簍imer1鐨勬椂闂存帶浠讹紝鐒跺悗澶嶅埗浠g爜灏卞彲浠ヨ繍琛屼簡锛屼竴寮濮璐悆铔娌″姩锛屾寜閿洏鍚庤椽鍚冭泧寮濮嬫湁鐐癸紝鐢ㄦ柟鍚戦敭鎺у埗鏂瑰悜 x As Integer y As Integer End Type Dim ax As Integer, ay As Integer Dim b() As ss Dim cx As Integer, cy ...
绛旓細鎶婁唬鐮佸鍒跺埌绌虹獥浣撲腑鎸塅5杩愯鍗冲彲銆侽ption Explicit Private WithEvents Timer1 As Timer Private WithEvents Label1 As Label Dim GFangXiang As Boolean Dim HWB As Single Dim She() As ShenTi Dim X As Long, Y As Long Dim ZhuangTai(23, 23) As Long Private Type ShenTi F As Long ...
绛旓細璐悆铔 Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)Dim C As Long If KeyCode = 27 Then End If KeyCode = 32 Then If Timer1.Enabled = True Then Timer1.Enabled = False Label1.Visible = True Else Timer1.Enabled = True Label1.Visible = False End If End If ...
绛旓細Shape2.Visible = False Randomize x = Fix(10 * Rnd + 1)y = Fix(10 * Rnd + 1)Shape2.Left = x * 300 Shape2.Top = y * 300 Shape2.Visible = True End If End If End Sub 鏁存浠g爜涓紝杩欎竴娈垫槸鍒ゆ柇鈥滆泧鈥濇槸鍚﹀凡缁忓悆鍒扳滄灉瀹炩濓紝濡傛灉鍚冨埌鈥滄灉瀹炩濆氨闅忔満浣嶇疆浜х敓涓涓滄灉瀹...
绛旓細鎴戝啓浜嗕釜绠鍗曠殑锛岀洿鎺ュ鍒朵唬鐮佸埌绐椾綋閲岄潰灏卞ソ浜嗭紝鐩稿叧鍔熻兘浣犲彲浠ヨ嚜宸卞畬鍠 Option Explicit Dim s As Integer Dim keyway As Integer Dim ate As Boolean Dim a, b As Integer Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)keyway = KeyCode Call Timer1_Timer End S...
绛旓細杩欎簺閮戒笉闅撅紝杩愮敤鍒颁竴浜涚壒娈娓告垙绠楁硶锛岃椽鍚冭泧锛氬垱寤簆ictureBox鎺т欢鏁扮粍, 鐒跺悗鍔犺韩瀛愬氨load picture1(picture1.UBound+1)鍦ㄥ0鏄庝竴涓姩鎬佹暟2d鏁扮粍锛屾瘡涓韩瀛愰兘鏈変竴涓猉锛孻鍊兼瘡绉诲姩涓娆璐悆铔囷紝澶撮儴鍏堣蛋涓姝ュ悗闈㈢殑韬瓙灏卞悜鍓嶄竴涓韩瀛愮殑浣嶇疆X,Y绉诲姩 flppy bird锛氳繍鐢ㄥ埌鍔犻熷害锛岄噸鍔涚墿鐞嗗锛屼互鍙婃煴瀛愮殑纰版挒妫娴...
绛旓細'璐悆铔浠g爜(鏃犳帶浠躲佸叏浠g爜锛塒rivate WithEvents Timer1 As Timer Private WithEvents Label1 As Label Dim GFangXiang As Boolean Dim HWB As Single Dim She() As ShenTi Dim X As Long, Y As Long Dim ZhuangTai(23, 23) As Long Private Type ShenTi F As Long X As Long Y As ...