VB编程开发游戏的全过程！ / 开普饭

大家好，今天我们共同来学习如何用VB编程来开发游戏。

VB编程，简单实用，功能强大，非常容易上手！

贪吃蛇游戏

贪吃蛇是一款经典的休闲游戏。

同时也是一款经典的益智游戏，有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

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)

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)

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

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

DrawEye

'传递运动方向

For i = intNum To 2 Step -1

intDirect(i) = intDirect(i - 1)

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

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)

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

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

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

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

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

Sub ShowNumber(m As Integer) '为指定的数字定位

Dim i As Integer, j As Integer

Dim k As Integer, l As Integer

Dim f As Boolean

Randomize

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

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

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

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) '读入蛇的初始位置和方向

MazeInfo(4, MazeNum) = 0 '默认的记录成绩

For i = 1 To 20

For j = 1 To 20

Input #1, Maze(i, j, MazeNum) '读入迷宫信息

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)

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) '默认运动方向

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

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

学习指南

1、VB全套学习教程，包括从基础入门到综合的视频讲解课、课件教程、编程实例大全、学习总结资料等已经整理完毕；

2、VB学习有问题可以随时提问。

愿大家都能顺利学好VB编程！

VB编程开发游戏的全过程！

相关推荐