贪吃蛇游戏
贪吃蛇是一款经典的休闲游戏，同时也是一款经典的益智游戏，有PC和手机等多平台版本。既简单又耐玩。
该游戏通过控制蛇头方向吃蛋，从而使得蛇变得越来越长。
游戏运行图
贪吃蛇游戏程序代码
Option Explicit
Option Base 1
Dim intEat As Integer
Dim intNum As Integer '节数
Dim intDirect() As Integer ' 每一节的运动方向
Const GRID As Integer = 20
Const GRID_NUM As Integer = 20
Dim AppleX(5) As Integer, AppleY(5) As Integer
Dim time_past As Integer
Public restart As Boolean
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case 37 'left
If intDirect(1) <> 0 Then intDirect(1) = enmLeft
Case 38 'up
If intDirect(1) <> 1 Then intDirect(1) = enmUp
Case 39 'right
If intDirect(1) <> 2 Then intDirect(1) = enmRight
Case 40 'down
If intDirect(1) <> 3 Then intDirect(1) = enmDown
Case 13 '回车可以暂停
Timer1.Enabled = Not Timer1.Enabled
If Not Timer1.Enabled Then
Me.Caption = "贪吃蛇(暂停)"
Timer2.Enabled = False
Else
Me.Caption = "贪吃蛇(运行)"
Timer2.Enabled = True
End If
Case 33
Timer1.Interval = Timer1.Interval - 20
Case 34
Timer1.Interval = Timer1.Interval + 20
End Select
Call DrawEye '显示眼睛转弯
'Print Height, Width
End Sub
Private Sub Form_Load()
Dim i As Integer
Call OpenMaze
Call OpenRecord
Pic.BackColor = lngBackColor
'调整大小与位置
Pic.Left = 20
Pic.Top = 20
Pic.Width = GRID * GRID_NUM + 6
Pic.Height = GRID * GRID_NUM + 6
Me.Width = (Pic.Left + Pic.Width + 20) * (Screen.TwipsPerPixelX)
Me.Height = (Pic.Top + Pic.Height + 20 + 40) * (Screen.TwipsPerPixelY)
'绘制格线
linHor(1).X1 = 0
linHor(1).X2 = GRID * GRID_NUM
linHor(1).Y1 = 0
linHor(1).Y2 = 0
linVer(1).X1 = 0
linVer(1).X2 = 0
linVer(1).Y1 = 0
linVer(1).Y2 = GRID * GRID_NUM
For i = 2 To 21
Load linHor(i)
linHor(i).Y1 = (i - 1) * GRID
linHor(i).Y2 = (i - 1) * GRID
Load linVer(i)
linVer(i).X1 = (i - 1) * GRID
linVer(i).X2 = (i - 1) * GRID
linHor(i).Visible = True
linVer(i).Visible = True
Next
Call DrawMaze
Call DrawSnake
Call ShowNumberAll
End Sub
Private Sub mnuAbout_Click()
MsgBox "贪吃蛇 Ver2.0" & Chr(13) & "CopyRight By ABC." & Chr(13) & "2003-07", 64, "版本说明"
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuHelphelp_Click()
frmHelp.Show 1
End Sub
Private Sub mnuNew_Click()
Dim i As Integer
Timer1.Enabled = False
Timer2.Enabled = False
Me.Caption = "贪吃蛇(按回车键开始)"
Pic.Cls
Pic.BackColor = lngBackColor
'初始化，为新一轮作准备
For i = intNum To 2 Step -1
Unload shp(i)
Next
Call DrawMaze
Call DrawSnake
Call ShowNumberAll
time_past = 0
intNum = 5
End Sub
Private Sub mnuPlayPause_Click()
SendKeys "{ENTER}"
End Sub
Private Sub mnuRecord_Click()
frmRecord.Show 1
End Sub
Private Sub mnuSetup_Click()
Dim i As Integer
restart = False
frmSetup.Show 1, Me
If restart Then '如果改变设置,则重新开始
Timer1.Enabled = False
Timer2.Enabled = False
Me.Caption = "贪吃蛇(按回车键开始)"
Pic.Cls
Pic.BackColor = lngBackColor
'初始化，为新一轮作准备
For i = intNum To 2 Step -1
Unload shp(i)
Next
Call DrawMaze
Call DrawSnake
Call ShowNumberAll
time_past = 0
intNum = 5
End If
End Sub
Private Sub Timer1_Timer()
Dim i As Integer
Dim m As Integer
Dim d As Integer
Dim game_over As Boolean
Dim LastLeft As Integer
Dim LastTop As Integer
Dim LastDirect As Direct
For m = 1 To 5
If Int(shp(1).Left / GRID) = AppleX(m) And Int(shp(1).Top / GRID) = AppleY(m) Then '如果吃到了数字
intEat = intEat + m
Call ShowNumber(m) '移动已吃数字
Exit For
End If
Next
LastLeft = shp(intNum).Left
LastTop = shp(intNum).Top
LastDirect = intDirect(intNum)
For i = 1 To intNum '蛇移动
Select Case intDirect(i)
Case 0
shp(i).Left = shp(i).Left + GRID
If shp(i).Left > 19 * GRID Then shp(i).Left = 0
Case 1
shp(i).Top = shp(i).Top + GRID
If shp(i).Top > 19 * GRID Then shp(i).Top = 0
Case 2
shp(i).Left = shp(i).Left - GRID
If shp(i).Left < 0 Then shp(i).Left = 19 * GRID
Case 3
shp(i).Top = shp(i).Top - GRID
If shp(i).Top < 0 Then shp(i).Top = 19 * GRID
End Select
Next
DrawEye
'传递运动方向
For i = intNum To 2 Step -1
intDirect(i) = intDirect(i - 1)
Next
If intEat > 0 Then
intEat = intEat - 1
intNum = intNum + 1
Load shp(intNum)
ReDim Preserve intDirect(intNum)
shp(intNum).FillColor = vbYellow
shp(intNum).Left = LastLeft
shp(intNum).Top = LastTop
shp(intNum).Visible = True
intDirect(intNum) = LastDirect
End If
If Maze(shp(1).Top \ GRID + 1, shp(1).Left \ GRID + 1, curMaze) = 1 Then ' 如果遇到了障碍物,撞死
game_over = True
End If
If Not game_over Then
For i = 2 To intNum
If shp(1).Left = shp(i).Left And shp(1).Top = shp(i).Top Then '如果撞到自已，撞死
game_over = True
End If
Next
End If
If game_over Then '如果已撞死
Timer1.Enabled = False
Timer2.Enabled = False
If intNum > MazeInfo(4, curMaze) Then '如果超过程记录
MazeName(2, curMaze) = InputBox("GAME OVER！" & Chr(10) & Chr(13) & "你的成绩为" & intNum & "分,用时" & time_past & "秒。" & Chr(10) & Chr(13) & "请留下大名：", "贪吃蛇", "无名侠")
MazeInfo(4, curMaze) = intNum
MazeInfo(5, curMaze) = time_past
Else
MsgBox "GAME OVER！", vbInformation, "贪吃蛇"
End If
Me.Caption = "贪吃蛇(按回车键开始)"
Pic.Cls
Pic.BackColor = lngBackColor
'初始化，为新一轮作准备
For i = intNum To 2 Step -1
Unload shp(i)
Next
Call DrawMaze
Call DrawSnake
Call ShowNumberAll
time_past = 0
intNum = 5
End If
End Sub
Sub ShowNumberAll() '为所有的数字定位
Dim i As Integer, j As Integer
Dim k As Integer, m As Integer, l As Integer
Dim f As Boolean
Randomize
For m = 1 To 5
Do
i = Int(Rnd * 20)
j = Int(Rnd * 20)
'判断数字出现的位置是否合理
f = True
For k = 1 To intNum '判断是否出现在蛇身上
If i = Int(shp(k).Left / GRID) And j = Int(shp(k).Top / GRID) Then
f = False
Exit For
End If
Next
If f = True Then
For k = 1 To m - 1 '判断是否出现在已有的数字上
If i * GRID = lblNumber(k).Left And j * GRID = lblNumber(k).Top Then
f = False
Exit For
End If
Next
End If
If f = True Then
For k = 1 To 20 '判断是否出现在障碍物上
For l = 1 To 20
If Maze(j + 1, i + 1, curMaze) = 1 Then
f = False
Exit For
End If
Next
Next
End If
If f = True Then
Exit Do
End If
Loop
AppleX(m) = i
AppleY(m) = j
lblNumber(m).Left = AppleX(m) * GRID
lblNumber(m).Top = AppleY(m) * GRID
Next
End Sub
Sub ShowNumber(m As Integer) '为指定的数字定位
Dim i As Integer, j As Integer
Dim k As Integer, l As Integer
Dim f As Boolean
Randomize
Do
i = Int(Rnd * 20)
j = Int(Rnd * 20)
' 判断数字出现的位置是否合理
f = True
For k = 1 To intNum
If i = Int(shp(k).Left / GRID) And j = Int(shp(k).Top / GRID) Then
f = False
Exit For
End If
Next
If f = True Then
For k = 1 To 5
If i * GRID = lblNumber(k).Left And j * GRID = lblNumber(k).Top Then
f = False
Exit For
End If
Next
End If
If f = True Then
For k = 1 To 20 '判断是否出现在障碍物上
For l = 1 To 20
If Maze(j + 1, i + 1, curMaze) = 1 Then
f = False
Exit For
End If
Next
Next
End If
If f = True Then
Exit Do
End If
Loop
AppleX(m) = i
AppleY(m) = j
lblNumber(m).Left = AppleX(m) * GRID
lblNumber(m).Top = AppleY(m) * GRID
End Sub
Private Sub Timer2_Timer()
time_past = time_past + 1
Caption = "贪吃蛇(运行)：" & time_past & "秒," & intNum & "分"
End Sub
Private Sub OpenMaze() '读入迷宫信息maze.def
Dim i As Integer, j As Integer
If Dir(App.Path & "\maze.def") = "" Then MsgBox "找不到迷宫定义文件：maze.def，程序终止。", vbCritical, "贪吃蛇": Unload Me
Open App.Path & "\maze.def" For Input As 1
Erase Maze, MazeName
MazeNum = 0
Do While Not EOF(1)
MazeNum = MazeNum + 1
ReDim Preserve Maze(20, 20, MazeNum), MazeName(2, MazeNum), MazeInfo(5, MazeNum)
Input #1, MazeName(1, MazeNum) '读入迷宫名
MazeName(2, MazeNum) = "无名氏" '默认的记录保持者
For i = 1 To 3
Input #1, MazeInfo(i, MazeNum) '读入蛇的初始位置和方向
Next
MazeInfo(4, MazeNum) = 0 '默认的记录成绩
For i = 1 To 20
For j = 1 To 20
Input #1, Maze(i, j, MazeNum) '读入迷宫信息
Next
Next
Loop
Close 1
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call SaveRecord
End Sub
Private Sub SaveRecord() '将设置记录到文件 snake.dat
Dim i As Integer
'读入设置文件内容
Open App.Path & "\snake.dat" For Output As 1
Print #1, curMaze '所选迷宫类型
Print #1, lngBackColor '背景与障碍物颜色
Print #1, lngMazeColor
For i = 1 To MazeNum '每个类型的记录保持者
Write #1, MazeName(2, i), MazeInfo(4, i), MazeInfo(5, i)
Next
Close #1
End Sub
Private Sub OpenRecord() '读入记录信息 snake.dat
Dim i As Integer
If Dir(App.Path & "\snake.dat") = "" Then '如果记录文件不存在
curMaze = 1
lngBackColor = vbGreen
lngMazeColor = vbBlue
Else '读入设置文件内容
Open App.Path & "\snake.dat" For Input As 1
Input #1, curMaze, lngBackColor, lngMazeColor
i = 0
Do While Not EOF(1)
i = i + 1
If i > MazeNum Then Exit Do
Input #1, MazeName(2, i), MazeInfo(4, i), MazeInfo(5, i) '读入记录保持者姓名和成绩和耗时
Loop
Close #1
End If
End Sub
Private Sub DrawSnake() '画蛇
Dim i As Integer
' If replay Then '如果为重新开始,则卸载已有的节点
' For i = intNum To 2 Step -1
' Unload shp(i)
' Next
' ReDim intDirect(1)
' End If
intNum = 5 '初始段数
ReDim intDirect(5)
intDirect(1) = MazeInfo(3, curMaze)
shp(1).Left = GRID * (MazeInfo(2, curMaze) - 1) '蛇头位置
shp(1).Top = GRID * (MazeInfo(1, curMaze) - 1)
For i = 2 To intNum '加载新节点并确定其相对于头部的位置
Load shp(i)
shp(i).FillColor = vbYellow
shp(i).Left = shp(i - 1).Left
shp(i).Top = shp(i - 1).Top
Select Case MazeInfo(3, curMaze)
Case enmRight
shp(i).Left = shp(i - 1).Left - GRID
Case enmLeft
shp(i).Left = shp(i - 1).Left + GRID
Case enmDown
shp(i).Top = shp(i - 1).Top - GRID
Case enmUp
shp(i).Top = shp(i - 1).Top - GRID
End Select
shp(i).Visible = True
intDirect(i) = MazeInfo(3, curMaze) '默认运动方向
Next
Call DrawEye
End Sub
Private Sub DrawMaze()
Dim i As Integer, j As Integer
For i = 1 To 20
For j = 1 To 20
If Maze(i, j, curMaze) = 1 Then
Pic.Line ((j - 1) * GRID + 2, (i - 1) * GRID + 2)-(j * GRID - 2, i * GRID - 2), lngMazeColor, BF
End If
Next
Next
End Sub
Private Sub DrawEye() '显示眼睛
Select Case intDirect(1)
Case enmRight
shpEyeL.Top = shp(1).Top
shpEyeL.Left = shp(1).Left + GRID / 2
shpEyeR.Top = shp(1).Top + GRID / 2
shpEyeR.Left = shp(1).Left + GRID / 2
Case enmLeft
shpEyeR.Top = shp(1).Top
shpEyeR.Left = shp(1).Left
shpEyeL.Top = shp(1).Top + GRID / 2
shpEyeL.Left = shp(1).Left
Case enmDown
shpEyeR.Top = shp(1).Top + GRID / 2
shpEyeR.Left = shp(1).Left
shpEyeL.Top = shp(1).Top + GRID / 2
shpEyeL.Left = shp(1).Left + GRID / 2
Case enmUp
shpEyeR.Top = shp(1).Top
shpEyeR.Left = shp(1).Left + GRID / 2
shpEyeL.Top = shp(1).Top
shpEyeL.Left = shp(1).Left
End Select
End Sub
愿大家都能顺利学好VB编程！
学习VB中有问题可以添加小编微信号：vbyjk521 ，随时在线答疑。
