准备六张以上的。
编程算法：
1、点击开始按钮（或者叫第一关），随机产生一张，以及价格（设置一变量来存储这个价格），开始计时，用timer控件控制，时间间隔设置成1秒
2、让用户猜价格（可在文本框中输入价格数字，再来个猜价格按钮），然后与上面的价格比较，给出高了或者低了提示。如果没有猜对，则所猜次数加1
3、可以根据游戏趣味性，选择所猜次数限制和时间限制，以复选框表示，并在后面加上限制次数或者时间秒数
4、猜对后，计时停止，提示恭喜您，猜对了。进入第二关，或者重新开始。上面的参数变量清零或者清空
备注：编写一个程序，关键是算法，只要算法清楚了，代码就很简单了。因为程序就是等于算法+代码
下面是个程序!希望有用
'定义蛇的运动速度枚举值
Private Enum tpsSpeed
QUICKLY = 0
SLOWLY = 1
End Enum
'定义蛇的运动方向枚举值
Private Enum tpsDirection
D_UP = 38
D_DOWN = 40
D_LEFT = 37
D_RIGHT = 39
End Enum
'定义运动区域4个禁区的枚举值
Private Enum tpsForbiddenZone
FZ_TOP = 30
FZ_BOTTOM = 5330
FZ_LEFT = 30
FZ_RIGHT = 5730
End Enum
'定义蛇头及身体初始化数枚举值
Private Enum tpsSnake
SNAKEONE = 1
SNAKETWO = 2
SNAKETHREE = 3
SNAKEFOUR = 4
End Enum
'定义蛇宽度的常量
Private Const SNAKEWIDTH As Integer = 100
'该过程用于显示游戏信息
Private Sub Form_Load()
MeShow
MelblTitle = "BS贪食蛇 — (版本 " & AppMajor & "" & AppMinor & "" & AppRevision & ")"
MeCaption = MelblTitleCaption
frmSplashShow 1
End Sub
'该过程用于使窗体恢复原始大小
Private Sub Form_Resize()
If MeWindowState <> 1 Then
MeCaption = ""
MeHeight = 6405 '窗体高度为 6405 缇
MeWidth = 8535 '窗体宽度为 8535 缇
MeLeft = (ScreenWidth - Width) \ 2
MeTop = (ScreenHeight - 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 + 32, "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 MechkPauseCaption = "暂停游戏(&P)" Then
MetmrSnakeMoveEnabled = False
MetmrGameTimeEnabled = False
MepicMoveAreaEnabled = False
MelblPauseLabVisible = True
MechkPauseCaption = "继续游戏(&R)"
Else
MetmrSnakeMoveEnabled = True
MetmrGameTimeEnabled = True
MepicMoveAreaEnabled = True
MelblPauseLabVisible = False
MechkPauseCaption = "暂停游戏(&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(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)
Beep
MsgBox "BS贪食蛇" & "(V-" & AppMajor & "" & AppMinor & "版本)" & Chr(13) & Chr(13) & _
"" & Chr(13) & Chr(13) & _
"由PigheadPrince设计制作" & Chr(13) & _
"CopyRight(C)2002,BestSoftTCG", 0, "关于本游戏"
End Sub
'该过程用于退出游戏
Private Sub cmdExit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Beep
msg = MsgBox("您要退出本游戏吗？", 4 + 32, "BS贪食蛇")
Select Case msg
Case 6
End
Case 7
MechkWindowButton(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 Mehwnd, 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 MechkWindowButton(0)Value = 1 Then
MeimgWindowTopBorderStyle = 0
MeimgWindowTopEnabled = False
Else
MeimgWindowTopBorderStyle = 1
MeimgWindowTopEnabled = True
End If
Case 1 '最小化
MeWindowState = 1
MechkWindowButton(1)Value = 0
MeCaption = "BS贪食蛇 — (V-" & AppMajor & "" & AppMinor & "版本)"
Case 2 '退出
Beep
msg = MsgBox("您要退出本游戏吗？", 4 + 32, "BS贪食蛇")
Select Case msg
Case 6
End
Case 7
MechkWindowButton(2)Value = 0
Exit Sub
End Select
End Select
End Sub
'该过程用于设置蛇运动速度的快慢
Private Sub hsbGameSpeed_Change()
MetmrSnakeMoveInterval = MehsbGameSpeedValue
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
MelblGameTimeCaption = 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
MepicMoveAreaSetFocus
MepicMoveAreaCls
'确认蛇头的运动方向并获取新的位置
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
MepicMoveAreaPSet (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
MepicMoveAreaPSet (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 + 16, "BS贪食蛇"
MetmrSnakeMoveEnabled = False
MetmrGameTimeEnabled = False
MepicMoveAreaVisible = False
Exit Sub
End If
'判断蛇在移动中是否碰到了自己的身体而导致游戏失败
If m_funTouchSnakeBody(g_udtSnake(SNAKEONE)Snake_CurX, g_udtSnake(SNAKEONE)Snake_CurY) Then
Beep
MsgBox "您的蛇在移动中碰到了自己的身体，游戏失败！", 0 + 16, "BS贪食蛇"
MetmrSnakeMoveEnabled = False
MetmrGameTimeEnabled = False
MepicMoveAreaVisible = False
Exit Sub
End If
'判断蛇是否吃到了果子
If m_funEatPoint(g_udtSnake(SNAKEONE)Snake_CurX, g_udtSnake(SNAKEONE)Snake_CurY) Then
'累加玩家的得分并刷新得分显示
g_intPlayerScore = g_intPlayerScore + 1
MelblYourScoreCaption = g_intPlayerScore & "分"
Call m_subAddSnake '加长蛇的身体
Call m_subGetPoint '获取下一个果子的位置和颜色
Else
'绘制果子
lngPointX = g_udtPointPoint_X
lngPointY = g_udtPointPoint_Y
lngPointColor = g_udtPointPoint_Color
MepicMoveAreaPSet (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 = 530
Snake_OldY = 530
Snake_Color = vbBlack
End With
'定义蛇身第2节的数据
With g_udtSnake(SNAKETWO)
Snake_OldX = 530
Snake_OldY = 430
Snake_Color = vbGreen
End With
'定义蛇身第3节的数据
With g_udtSnake(SNAKETHREE)
Snake_OldX = 530
Snake_OldY = 330
Snake_Color = vbYellow
End With
'定义蛇身第4节的数据
With g_udtSnake(SNAKEFOUR)
Snake_OldX = 530
Snake_OldY = 230
Snake_Color = vbRed
End With
MepicMoveAreaVisible = True
MelblYourScoreCaption = g_intPlayerScore & "分"
MelblGameTimeCaption = g_lngGameTime & "秒"
MetmrSnakeMoveInterval = MehsbGameSpeedValue
MetmrSnakeMoveEnabled = True
MetmrGameTimeEnabled = 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((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)
MePSet (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_udtPointPoint_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_udtPointPoint_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_udtPointPoint_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_udtPointPoint_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
MepicMoveAreaPSet (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_udtPointPoint_X) <= SNAKEWIDTH And Abs(SnakeY - g_udtPointPoint_Y) <= SNAKEWIDTH Then
m_funEatPoint = True
Else
m_funEatPoint = False
End If
End 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 Long
Public Const WM_SYSCOMMAND = &H112 '声明向Windows发送消息的常量
Public Const SC_MOVE = &HF012 '声明控制移动窗体常量
'（游戏变量声明部分）-------------------------------------------------------------
'定义蛇的数据类型结构
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
dqOpen
"Select
from
picture
where
id
like'"
&
pa
&
"'"，myconn，1，2
Set
Image1DataSource
=
Nothing
Set
Image1DataSource
=
dq
Image1DataField
=
"pic"
dqClose
你的二进制图像要先存入ACCESS表中，命名picture，id可以用自动编号，字段名pic
首先要连接到版数据库。然后权把上面的代码黏贴进去。
代码的意思是
1从picture中选择id=的打开(
作为一个记录集)
2先清空图像image1控件
3image1控件的来源是dq(这是一个记录集)
4image1控件与数据库绑定的字段名是pic
不知道是不是你想要的额。
1、VB程序设计以VisualBasic60简体中文版为语言背景，深入浅出的介绍VisualBasic60程序设计技术，基本涵盖了VisualBasic60编程时的常用内容。
2、VB程序设计共分14章，主要内容包括开发环境、语言基础和数组与过程、常用控件、菜单设计、文件处理、ActiveX控件、数据库程序设计、图形程序设计、多媒体编程、网络编程、API函数和注册表、安装程序的制作和综合实例。
3、为了方便读者学习，《VB程序设计》提供多媒体课件，及例题和练习题的所有源代码。
4、VB程序设计可以作为大中专院校计算机及相关专业的教材，适合编程爱好者自学使用。
VisualBasic是一种由微软公司开发的包含协助开发环境的事件驱动编程语言。从任何标准来说，VB都是世界上使用人数最多的语言——不仅是盛赞VB的开发者还是抱怨VB的开发者的数量。它源自于BASIC编程语言。VB拥有图形用户界面（GUI）和快速应用程序开发（RAD）系统，可以轻易的使用DAO、RDO、ADO连接数据库，或者轻松的创建ActiveX控件。程序员可以轻松的使用VB提供的组件快速建立一个应用程序。VB的中心思想就是要便于程序员使用，无论是新手或者专家。VB使用了可以简单建立应用程序的GUI系统，但是又可以开发相当复杂的程序。VB的程序是一种基于窗体的可视化组件安排的联合，并且增加代码来指定组件的属性和方法。因为默认的属性和方法已经有一部分定义在了组件内，所以程序员不用写多少代码就可以完成一个简单的程序。过去的版本里面VB程序的性能问题一直被放在了桌面上，但是随着计算机速度的飞速增加，关于性能的争论已经越来越少。
窗体控件的增加和改变可以用拖放技术实现。一个排列满控件的工具箱用来显示可用控件（比如文本框或者按钮)。每个控件都有自己的属性和事件。默认的属性值会在控件创建的时候提供，但是程序员也可以进行更改。很多的属性值可以在运行时候随着用户的动作和修改进行改动，这样就形成了一个动态的程序。举个例子来说：窗体的大小改变事件中加入了可以改变控件位置的代码，在运行时候每当用户更改窗口大小，控件也会随之改变位置。在文本框中的文字改变事件中加入相应的代码，程序就能够在文字输入的时候自动翻译或者阻止某些字符的输入。
VB的程序可以包含一个或多个窗体，或者是一个主窗体和多个子窗体，类似于 *** 作系统的样子。有很少功能的对话框窗口（比如没有最大化和最小化按钮的窗体）可以用来提供d出功能。
VB的组件既可以拥有用户界面，也可以没有。这样一来服务器端程序就可以处理增加的模块。
VB使用参数计算的方法来进行垃圾收集，这个方法中包含有大量的对象，提供基本的面向对象支持。因为越来越多组件的出现，程序员可以选用自己需要的扩展库。和有些语言不一样，VB对大小写不敏感，但是能自动转换关键词到标准的大小写状态，以及强制使得符号表入口的实体的变量名称遵循书写规则。默认情况下字符串的比较是对大小写敏感的，但是可以关闭这个功能。
VB使得大量的外界控件有了自己的生存空间。大量的第三方控件针对VB提供。VB也提供了建立、使用和重用这些控件的方法，但是由于语言问题，从一个应用程序创建另外一个并不简单。
'定义蛇的运动速度枚举值
Private Enum tpsSpeed
QUICKLY = 0
SLOWLY = 1
End Enum
'定义蛇的运动方向枚举值
Private Enum tpsDirection
D_UP = 38
D_DOWN = 40
D_LEFT = 37
D_RIGHT = 39
End Enum
'定义运动区域4个禁区的枚举值
Private Enum tpsForbiddenZone
FZ_TOP = 30
FZ_BOTTOM = 5330
FZ_LEFT = 30
FZ_RIGHT = 5730
End Enum
'定义蛇头及身体初始化数枚举值
Private Enum tpsSnake
SNAKEONE = 1
SNAKETWO = 2
SNAKETHREE = 3
SNAKEFOUR = 4
End Enum
'定义蛇宽度的常量
Private Const SNAKEWIDTH As Integer = 100
'该过程用于显示游戏信息
Private Sub Form_Load()
MeShow
MelblTitle = "BS贪食蛇 — (版本 " & AppMajor & "" & AppMinor & "" & AppRevision & ")"
MeCaption = MelblTitleCaption
frmSplashShow 1
End Sub
'该过程用于使窗体恢复原始大小
Private Sub Form_Resize()
If MeWindowState > 1 Then
MeCaption = ""
MeHeight = 6405 '窗体高度为 6405 缇
MeWidth = 8535 '窗体宽度为 8535 缇
MeLeft = (ScreenWidth - Width) \ 2
MeTop = (ScreenHeight - 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 + 32, "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 MechkPauseCaption = "暂停游戏(&P)" Then
MetmrSnakeMoveEnabled = False
MetmrGameTimeEnabled = False
MepicMoveAreaEnabled = False
MelblPauseLabVisible = True
MechkPauseCaption = "继续游戏(&R)"
Else
MetmrSnakeMoveEnabled = True
MetmrGameTimeEnabled = True
MepicMoveAreaEnabled = True
MelblPauseLabVisible = False
MechkPauseCaption = "暂停游戏(&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(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)
Beep
MsgBox "BS贪食蛇" & "(V-" & AppMajor & "" & AppMinor & "版本)" & Chr(13) & Chr(13) & _
"" & Chr(13) & Chr(13) & _
"由PigheadPrince设计制作" & Chr(13) & _
"CopyRight(C)2002,BestSoftTCG", 0, "关于本游戏"
End Sub
'该过程用于退出游戏
Private Sub cmdExit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Beep
msg = MsgBox("您要退出本游戏吗？", 4 + 32, "BS贪食蛇")
Select Case msg
Case 6
End
Case 7
MechkWindowButton(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 Mehwnd, 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 MechkWindowButton(0)Value = 1 Then
MeimgWindowTopBorderStyle = 0
MeimgWindowTopEnabled = False
Else
MeimgWindowTopBorderStyle = 1
MeimgWindowTopEnabled = True
End If
Case 1 '最小化
MeWindowState = 1
MechkWindowButton(1)Value = 0
MeCaption = "BS贪食蛇 — (V-" & AppMajor & "" & AppMinor & "版本)"
Case 2 '退出
Beep
msg = MsgBox("您要退出本游戏吗？", 4 + 32, "BS贪食蛇")
Select Case msg
Case 6
End
Case 7
MechkWindowButton(2)Value = 0
Exit Sub
End Select
End Select
End Sub
'该过程用于设置蛇运动速度的快慢
Private Sub hsbGameSpeed_Change()
MetmrSnakeMoveInterval = MehsbGameSpeedValue
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
MelblGameTimeCaption = 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
MepicMoveAreaSetFocus
MepicMoveAreaCls
'确认蛇头的运动方向并获取新的位置
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
MepicMoveAreaPSet (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
MepicMoveAreaPSet (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 + 16, "BS贪食蛇"
MetmrSnakeMoveEnabled = False
MetmrGameTimeEnabled = False
MepicMoveAreaVisible = False
Exit Sub
End If
'判断蛇在移动中是否碰到了自己的身体而导致游戏失败
If m_funTouchSnakeBody(g_udtSnake(SNAKEONE)Snake_CurX, g_udtSnake(SNAKEONE)Snake_CurY) Then
Beep
MsgBox "您的蛇在移动中碰到了自己的身体，游戏失败！", 0 + 16, "BS贪食蛇"
MetmrSnakeMoveEnabled = False
MetmrGameTimeEnabled = False
MepicMoveAreaVisible = False
Exit Sub
End If
'判断蛇是否吃到了果子
If m_funEatPoint(g_udtSnake(SNAKEONE)Snake_CurX, g_udtSnake(SNAKEONE)Snake_CurY) Then
'累加玩家的得分并刷新得分显示
g_intPlayerScore = g_intPlayerScore + 1
MelblYourScoreCaption = g_intPlayerScore & "分"
Call m_subAddSnake '加长蛇的身体
Call m_subGetPoint '获取下一个果子的位置和颜色
Else
'绘制果子
lngPointX = g_udtPointPoint_X
lngPointY = g_udtPointPoint_Y
lngPointColor = g_udtPointPoint_Color
MepicMoveAreaPSet (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 = 530
Snake_OldY = 530
Snake_Color = vbBlack
End With
'定义蛇身第2节的数据
With g_udtSnake(SNAKETWO)
Snake_OldX = 530
Snake_OldY = 430
Snake_Color = vbGreen
End With
'定义蛇身第3节的数据
With g_udtSnake(SNAKETHREE)
Snake_OldX = 530
Snake_OldY = 330
Snake_Color = vbYellow
End With
'定义蛇身第4节的数据
With g_udtSnake(SNAKEFOUR)
Snake_OldX = 530
Snake_OldY = 230
Snake_Color = vbRed
End With
MepicMoveAreaVisible = True
MelblYourScoreCaption = g_intPlayerScore & "分"
MelblGameTimeCaption = g_lngGameTime & "秒"
MetmrSnakeMoveInterval = MehsbGameSpeedValue
MetmrSnakeMoveEnabled = True
MetmrGameTimeEnabled = 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((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)
MePSet (lngPointX, lngPointY), lngPointColor
'设置函数返回值
With g_udtPoint
Point_X = lngPointX
Point_Y = lngPointY
Point_Color = lngPointColor
End With
End Sub
以上就是关于VB闯关游戏代码（趣味撞球），一关比一关难的那种全部的内容，包括:VB闯关游戏代码（趣味撞球），一关比一关难的那种、用VB怎么做一个小游戏啊、用VB写图像检索程序等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！
欢迎分享，转载请注明来源：内存溢出
微信扫一扫
支付宝扫一扫
评论列表（0条）