vb编程小游戏,如何设计一个很简单的VB程序小游戏

vb编程小游戏,如何设计一个很简单的VB程序小游戏详细介绍

本文目录一览： 如何用VB制作拼图游戏？

分类: 电脑/网络 >> 程序设计 >> 其他编程语言
问题描述:

最近老师让我们学习如何用VB来制作游戏,就是想把在在的图片弄成拼图的一个小游戏,不过我不知道怎么写程序,有没有哪位能帮我一下呀!
解析:

用PaintPicture来将一个大图片的分块显示在几个不同的小Picture控件里，事先给让这几个Picture控件随机的两两掉换位置N次，这样就把原图打乱了。判断是否拼图成功就判断小图片的位置是否回到了原来初始位置，如果所有的小图片的位置都恢复正确那么拼图成功，具体的你应该会做了。
QQ：***********

vb小游戏源代码

Rem 窗体创建三个单选框按钮，Option1、Option2、Option3
Private Sub Form_Activate()
Option1.Caption = "石头"
Option2.Caption = "剪刀"
Option3.Caption = "布"
Option1.Value = False
Option2.Value = False
Option3.Value = False
End Sub
Private Sub Option1_Click()
Randomize
Select Case Int(3 * Rnd)
Case 0: MsgBox "对方也出石头！继续！"
Case 1: MsgBox "哈哈！你赢了！对方出的是剪刀！奖励你一个苹果！"
Case 2: MsgBox "你输了！对方出的是布哦！不好意思，苹果给对方了哈！"
End Select
Option1.Value = False
End Sub
Private Sub Option2_Click()
Randomize
Select Case Int(3 * Rnd)
Case 0: MsgBox "你输了！对方出的是石头哦！不好意思，苹果给对方了哈！"
Case 1: MsgBox "对方也出剪刀！继续！"
Case 2: MsgBox "哈哈！你赢了！对方出的是布！奖励你一个苹果！"
End Select
Option2.Value = False
End Sub
Private Sub Option3_Click()
Randomize
Select Case Int(3 * Rnd)
Case 0: MsgBox "哈哈！你赢了！对方出的是石头！奖励你一个苹果！"
Case 1: MsgBox "你输了！对方出的是剪刀哦！不好意思，苹果给对方了哈！"
Case 2: MsgBox "对方也出布！继续！"
End Select
Option3.Value = False
End Sub
Dim pFist, cFist, cCount, pCount, dCount, tCount As Integer
Private Sub Form_Load()
cCount = 0
pCount = 0
dCount = 0
tCount = 1
lblPWinNum.Caption = ""
lblPWinNum.Caption = lblPWinNum.Caption & pCount
lblCWinNum.Caption = ""
lblCWinNum.Caption = lblCWinNum.Caption & cCount
lblDrawNum.Caption = ""
lblDrawNum.Caption = lblDrawNum.Caption & dCount
lblTotalNum.Caption = ""
lblTotalNum.Caption = lblTotalNum.Caption & tCount
End Sub
Private Sub imgCloth_Click()
pFist = 3
cFist = Int(Rnd * 3) + 1
txtPlayer.Text = ""
txtPlayer.Text = txtPlayer.Text & "布"
If cFist = 1 Then
txtComputer = ""
txtComputer = txtComputer & "石头"
Else
If cFist = 2 Then
txtComputer = ""
txtComputer = txtComputer & "剪刀"
Else
If cFist = 3 Then
txtComputer = ""
txtComputer = txtComputer & "布"
End If
End If
End If
If cFist = 1 Then
pCount = pCount + 1
lblPWinNum.Caption = ""
lblPWinNum.Caption = lblPWinNum.Caption & pCount
picSusess.Visible = True
MsgBox "恭喜你，你赢了！"
Else
If cFist = 2 Then
cCount = cCount + 1
lblCWinNum.Caption = ""
lblCWinNum.Caption = lblCWinNum.Caption & cCount
MsgBox "很遗憾，你输了！"
Else
dCount = dCount + 1
lblDrawNum.Caption = ""
lblDrawNum.Caption = lblDrawNum.Caption & dCount
MsgBox "打平了！"
End If
End If
tCount = tCount + 1
lblTotalNum.Caption = ""
lblTotalNum.Caption = lblTotalNum.Caption & tCount
End Sub
Private Sub imgScissors_Click()
pFist = 2
cFist = Int(Rnd * 3) + 1
txtPlayer.Text = ""
txtPlayer.Text = txtPlayer.Text & "剪刀"
If cFist = 1 Then
txtComputer = ""
txtComputer = txtComputer & "石头"
Else
If cFist = 2 Then
txtComputer = ""
txtComputer = txtComputer & "剪刀"
Else
If cFist = 3 Then
txtComputer = ""
txtComputer = txtComputer & "布"
End If
End If
End If
If cFist = 3 Then
pCount = pCount + 1
lblPWinNum.Caption = ""
lblPWinNum.Caption = lblPWinNum.Caption & pCount
picSusess.Visible = True
MsgBox "恭喜你，你赢了！"
Else
If cFist = 1 Then
cCount = cCount + 1
lblCWinNum.Caption = ""
lblCWinNum.Caption = lblCWinNum.Caption & cCount
MsgBox "很遗憾，你输了！"
Else
dCount = dCount + 1
lblDrawNum.Caption = ""
lblDrawNum.Caption = lblDrawNum.Caption & dCount
MsgBox "打平了！"
End If
End If
tCount = tCount + 1
lblTotalNum.Caption = ""
lblTotalNum.Caption = lblTotalNum.Caption & tCount
End Sub
Private Sub imgStone_Click()
pFist = 1
cFist = Int(Rnd * 3) + 1
txtPlayer.Text = ""
txtPlayer.Text = txtPlayer.Text & "石头"
If cFist = 1 Then
txtComputer = ""
txtComputer = txtComputer & "石头"
Else
If cFist = 2 Then
txtComputer = ""
txtComputer = txtComputer & "剪刀"
Else
If cFist = 3 Then
txtComputer = ""
txtComputer = txtComputer & "布"
End If
End If
End If
If cFist = 2 Then
pCount = pCount + 1
lblPWinNum.Caption = ""
lblPWinNum.Caption = lblPWinNum.Caption & pCount
picSusess.Visible = True
MsgBox "恭喜你，你赢了！"
Else
If cFist = 3 Then
cCount = cCount + 1
lblCWinNum.Caption = ""
lblCWinNum.Caption = lblCWinNum.Caption & cCount
MsgBox "很遗憾，你输了！"
Else
dCount = dCount + 1
lblDrawNum.Caption = ""
lblDrawNum.Caption = lblDrawNum.Caption & dCount
MsgBox "打平了！"
End If
End If
tCount = tCount + 1
lblTotalNum.Caption = ""
lblTotalNum.Caption = lblTotalNum.Caption & tCount
End Sub
Private Sub picSusess_Click()
picSusess.Visible = False
End Sub
我原来做的一个，按照你的提示加了一个图片，picSusess这个就是图片，里面放着一个苹果的图片，当你赢了就会出现，你点击一下，那个图片就消失，我这个里面除了你这个功能，还有战绩提示，统计你胜负平的局数和第多少局（计算公式是胜负平的局数+1，就是当前局数）
Rem 窗体创建三个单选框按钮，Option1、Option2、Option3。
小游戏是一个较模糊的概念，它是相对于体积庞大的单机游戏及网络游戏而言的，泛指所有体积较小、玩法简单的游戏，通常这类游戏以休闲益智类为主，有单机版有网页版，在网页上嵌入的多为FLASH格式。
当下小游戏主要是指在线玩的flash版本游戏，统称小游戏，其实小游戏还包含单机游戏，小型游戏机等。一般游戏大小小于10m的游戏都统称为小游戏，一些街机类小游戏。因其游戏安装简便，耐玩性强，无依赖性而广受白领及小朋友的喜爱。
小游戏”这个词的型含义其实很简单，它不是一些大的游戏，不必花费更多的时间和精力。
小游戏是原始的游戏娱乐方式，小游戏本身是为了叫人们在工作，学习后的一种娱乐、休闲的一种方式，不是为了叫玩家为之花费金钱、花费精力，更不是叫玩家为他痴迷。
小游戏也可以理解为“Flash游戏”，是以SWF为后缀的游戏的总称.这些游戏是通过Flash软件和 Flash 编程语言 Flash ActionScript 制作而成。
由于Flash是矢量软件，所以小游戏放大后几乎不影响画面效果。Flash小游戏是一种新兴起的游戏形式，以游戏简单，操作方便，绿色，无需安装，文件体积小等优点渐渐被广大网友喜爱。

怎么编程_怎么编程做一个小游戏

这么多草看到明天我郁闷
如果您想学习编程，却又不知从何入手，那么您不妨看看下面的几种学习方案，可能会给您一些启示吧！
==============================================
方案一Basic语言&VisualBasic
优点
（1）Basic简单易学，很容易上手。
（2）VisualBasic提供了强大的可视化编程能力，可以让你轻松地做出漂亮的程序。
（3）众多的控件让编程变得象垒积木一样简单。
（4）VisualBasic的全部汉化让我们这些见了English就头大的人喜不自禁。
缺点
（1）VisualBasic不是真正的面向对象的开发文具。
（2）VisualBasic的数据类型太少，而且不支持指针，这使得它的表达能力很有限。
（3）VisualBasic不是真正的编译型语言，它产生的最终代码不是可执行的，是一种伪代码。它需要一个动态链接库去解释执行，这使得VisualBasic的编译速度大大变慢。
综述：方案一适合初涉编程的朋友，它对学习者的要求不高，几乎每个人都可以在一个比较短的时间里学会vB编程，并用VB做出自己的作品。对于那些把编程当做游戏的朋友来说，VB是您最佳的选择。
Basic/VisualBasic简介
==============================================
方案二Pascal语言&Delphi
优点
（1）Pascal语言结构严谨，可以很好地培养一个人的编程思想。
（2）Delphi是一门真正的面向对象的开发工具，并且是完全的可视化。
（3）Delphi使用了真编译，可以让你的代码编译成为可执行的文件，而且编译速度非常快。
（4）Delphi具有强大的数据库开发能力，可以让你轻松地开发数据库。
缺点
Delphi几乎可以说是完美的，只是Pascal语言的过于严谨让人感觉有点烦。
综述:方案二比较适合那些具有一定编程基础并且学过Pascal语言的朋友。
Pascal语言简介
Delphi简介
==============================================
方案三C语言&VisualC
优点
（1）C语言灵活性好，效率高，可以接触到软件开发比较底层的东西。
（2）微软的MFC库博大精深，学会它可以让随心所欲地进行编程。
（3）VC是微软制作的产品，与操作系统的结合更加紧密。
缺点
对使用者的要求比较高，既要具备丰富的C语言编程经验，又要具有一定的WINDOWS编程基础，它的过于专业使得一般的编程爱好者学习起来会有不小的困难。
综述:VC是程序员用的东西。如果你是一个永不满足的人，而且可以在编程上投入很大的精力和时间，那么学习VC你一定不会后悔的。
C语言简介
==============================================
方案四C语言&CBuilder
优点
（1）C语言的优点全部得以继承。
（2）完全的可是化。
（3）极强的兼容性，支持OWL、VCL和MFC三大类库。
（4）编译速度非常快。
缺点
由于推出的时间太短，关于它的各种资料还不太多。
综述：我认为CBuilder是最好的编程工具。它既保持了C语言编程的优点，又做到了完全的可视化。
C语言简介
==============================================
方案五SQL语言&PowerBuilder
对于一些传统的数据开发人员来说，Foxpro系列也许让他们感到更加熟悉。但是对于初学者来说，也许是最好的数据库开发工具。各种各样的控件，功能强大的语言都会帮助你开发出自己的数据库应用程序。
[NextPage]
JSP简介
在Sun正式发布JSP(JavaServerPages)之后，这种新的Web应用开发技术很快引起了人们的关注。JSP为创建高度动态的Web应用提供了一个独特的开发环境。按照Sun的说法，JSP能够适应市场上包括ApacheWebServer、IIS4.0在内的85%的服务器产品

如何设计一个很简单的VB程序小游戏

利用vb控件做个坦克大战类的游戏即可，炮弹和坦克都用控件实现就行。唯一难点是控制控件移动以及炮弹击中目标的碰撞检测判断。给你一个简单实现代码
这是一种碰撞检测方法，下述属于简化的矩形碰撞检测，若是需要复杂碰撞可以用一个数组来记录大量需要碰撞检测的物体
image1里读入坦克的图片
image2里读入地雷的图片
然后用下面代码即可实现
Private
Sub
Form_KeyPress(KeyAscii
As
Integer)
'按键盘A和D键控制猫图片image1左右移动
If
KeyAscii
=
97
Then
Image1.Left
=
Image1.Left
-
10
If
KeyAscii
=
100
Then
Image1.Left
=
Image1.Left
+
10
'如果坦克图片与地雷图片相遇则提示碰撞到了
If
Image1.Left
+
Image1.Width
>
Image2.Left
Then
If
Image1.Left
<
Image2.Left
+
Image2.Width
Then
If
Image1.Top
+
Image1.Height
>
Image2.Top
Then
If
Image1.Top
<
Image2.Top
+
Image2.Height
Then
MsgBox
"坦克碰到地雷，已经被炸毁了"
End
If
End
If
End
If
End
If
End
Sub

用vb做一个小游戏 希望每一步有详细解释

分太少了吧
分太少了吧
猜数游戏
做个贪吃蛇，flppy bird，纵向像素赛车，推箱子，水果机
这些都不难，运用到一些特殊游戏算法，
贪吃蛇：创建pictureBox控件数组, 然后加身子就load picture1(picture1.UBound+1)
在声明一个动态数2d数组，每个身子都有一个X，Y值每移动一次贪吃蛇，头部先走一步后面的身子就向前一个身子的位置X,Y移动
flppy bird：运用到加速度，重力物理学，以及柱子的碰撞检测
纵向赛车：随机下来几个pictureBox，如果有方块的纵坐标超过了一定量，那就再从顶部开始下滑（呈现赛车相对几个障碍物向上走的视觉效应）
推箱子：这个实现起来不容易，要把每一次箱子的位置映像成2D数组，然后根据2d数组坐标判断对的箱子，箱子和箱子，箱子和墙，箱子和目标，hero和箱子的几种关系要搞清，谁是主动，谁是被动，谁碰到谁再碰到谁就不能再碰哈哈
水果机：相对没什么技术含量，计数器累加再弄一个小球在屏幕上转圈滚动，滚动到事先生成的随机数等于累加的数字时，停止小球的滚动，停在了那里就用计数变量mod加分类别，最终该得多少分，输出在text里面。。

vb好学吗，能否简单地写一个小游戏？

敲代码很好学。
在面向对象的程序设计中，我们把外界的刺激用事件来表示，而把对这个事件的反应称为事件过程。
可视化和事件驱动正是使用VB进行Windows程序设计的精髓所在。事件驱动，即事件发生时，程序才会运行，在没有事件时，整个程序处于停滞状态。事件决定了对象之间的联系。在VB中，事件就是能够被对象识别的动作，如用鼠标单击或双击，键盘输入、鼠标的移动、窗体的载入，还有定时器产生的定时信号。
VB的每个窗体和控件都有一个预定义的事件集，它们能够自动识别属于事件集中的事件，大多数类型的事件是各种控件所共有的，例如命令按钮和窗体都可以对单击、双击和按键这样的事件做出响应，而某些事件只能发生在特定的对象上。 *相同的事件发生在不同的对象上得到的反应是不一样的，造成这种差异是事件过程的缘故，对象对每一个可以识别的事件都有一个事件过程，当事件发生时，会自动执行这个事件的过程。语法如下：
Private Sub 对象名_事件()
处理事件的程序代码
End Sub
在VB程序设计过程中，基本的思想就是改变对象的属性，使用对象的方法和为对象的事件编写事件过程。除非有必要，用户不必为所有的事件编写事件过程，Windows系统会以默认的方式来处理事件。使用VB编写程序的妙处在于：只有当用户要以某种特定方式来响应某个事件时，才有必要针对某个事件的事件过程。
事件驱动程序中典型的事件序列：
启动应用程序，装载并显示窗体，产生Load和Show事件。
窗体或窗体上的控件接收事件。事件可以由用户引发、由系统引发，也可以由代码间接引发。
如果在相应的事件过程中存在代码，则执行代码。
应用程序等待下一次事件。
应用程序中使用一个窗体时，程序开始运行时窗体接收到了Load消息，从而引发了窗体的Load事件，在这个默认的事件过程中，什么语句都没有，这个过程只是调用就结束了，而VB则执行了一个重要的默认操作——把窗体装入内存。
许多事件的发生常常会伴随其它事件发生：双击事件发生时，按下鼠标键、复原鼠标键和单击事件也会发生。
希望我能帮助你解疑释惑。

VB编写小游戏

窗体放两个Label控件，一个Timer控件：
Dim n As Integer
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyUp
If Label1.Top > 0 Then Label1.Top = Label1.Top - 50
Case vbKeyDown
If Label1.Top < ScaleHeight - Label1.Height Then Label1.Top = Label1.Top + 50
Case vbKeyLeft
If Label1.Left > 0 Then Label1.Left = Label1.Left - 50
Case vbKeyRight
If Label1.Left < ScaleWidth - Label1.Width Then Label1.Left = Label1.Left + 50
End Select
Call check
End Sub
Private Sub check()
If Abs(Label1.Top - Label2.Top) <= 50 And Abs(Label1.Left - Label2.Left) <= 50 Then
n = n + 1
Label2.Move Rnd * ScaleWidth, Rnd * ScaleHeight
End If
End Sub
Private Sub Form_Load()
KeyPreview = True
Randomize
With Label1
.Caption = ""
.BackColor = vbWhite
.Move (ScaleWidth - .Width) / 2, (ScaleHeight - .Height) / 2, 500, 500
End With
With Label2
.Caption = ""
.BackColor = vbYellow
.Move Rnd * ScaleWidth, Rnd * ScaleHeight, 500, 500
End With
Timer1.Interval = 60000
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
MsgBox "这局对准了" & n & "次黄方块"
Unload Me
End Sub

如何用VB做九宫格小游戏

数独初盘最少可以有17个数，最多32个，9*9的格子
随机取，然后行和列上遍历不能出现重复数字，就ok了
首先，请楼主确认您说的九宫格是
各项之和15呢
还是各行各列0-9各出现一次的数独游戏，这是2种不同的算法，关系到后面设计过程，一定要说清楚。
其次，因为不确定算法，我只给出搭建界面的过程：
建立个form
拖9*9个label
搭建成游戏需要的样子，这个可以参考别人的界面，一个command
一个分数计算显示用的Label。
等待楼主交代详细。。。
随机数就用
Rnd函数嘛
比如
int（Rnd*10）
。不重复的话，就每取一次都保存起来，然后和前几次判断，有重复的就重新取。。。。。
再看看别人怎么说的。
9宫格你的意思是各项之和都是15么？
可以这样：
添加9个textbox（可以写成控件数组），然后对于每个textbox的TextChange事件添加代码，检测如果每行每列都是15，则成功；

如何用VB程序设计打地鼠游戏

下面是源代码：
Form1:
Private Sub Form_Load() Dim temp As Integer Randomize
temp = Int(Rnd * 3) + 1
Form1.Picture = LoadPicture("C:\Users\Administrator\Desktop\打地鼠\picture" & temp & ".jpg") WindowsMediaPlayer1.URL = "C:\Users\Administrator\Desktop\打地鼠\Heaven's Devils.wma" End Sub
Private Sub Label1_Click() Form2.Show Form2.num = -1 Form1.Hide
WindowsMediaPlayer1.URL = ""
Open "C:\Users\Administrator\Desktop\打地鼠\primary.dat" For Append As #1 '写操作 Close #1
Open "C:\Users\Administrator\Desktop\打地鼠\intermediate.dat" For Append As #2 Close #2
Open "C:\Users\Administrator\Desktop\打地鼠\advanced.dat" For Append As #3 Close #3 End Sub
Private Sub Label2_Click() End End Sub
Form2:
Dim allnum As Integer, oknum As Integer '定义变化次数 打中次数 Public num As Integer '判别是否第一次开始游戏 Dim flags1 As Boolean '判别文件是否保存 Public flags As Boolean '判别是否播放声音 Private Sub countine_Click() pause.Enabled = True Timer1.Enabled = True countine.Enabled = False WLXZ.Enabled = True End Sub
Private Sub exit_Click() Dim X As Integer Dim tt As Integer
X = MsgBox("是否真的退出？", vbYesNo, "退出游戏框")
If X = 6 Then
tt = MsgBox("退出游戏之前,是否保存", vbYesNo, "保存提示") If tt = 6 Then
If flags1 = True Then End Else
If Timer1.Interval = 1000 Then
Open "C:\Users\Administrator\Desktop\打地鼠\primary.dat" For Append As #1 '写操作
Print #1, Text1.Text + " " + Format(Date, "M/d/yy") Close #1
ElseIf Timer1.Interval = 500 Then
Open "C:\Users\Administrator\Desktop\打地鼠\intermediate.dat" For Append As #2
Print #2, Text1.Text + " " + Format(Date, "M/d/yy") Close #2 Else
Open "C:\Users\Administrator\Desktop\打地鼠\advanced.dat" For Append As #3
Print #3, Text1.Text + " " + Format(Date, "M/d/yy") Close #3 End If End If End If End End If End Sub
Private Sub Form_Load() Form4.Check1.Value = 1
WindowsMediaPlayer1.Controls.stop countine.Enabled = False pause.Enabled = False WLXZ.Enabled = False
Form5.Top = Form2.Top + 700 Form5.Left = Form2.Left flags1 = False flags = True End Sub
Private Sub help_Click() Form3.Show End Sub
Private Sub new_game_Click() num = num + 1 Dim t As Integer
If (num > 0) Then
t = MsgBox("新游戏开始之前,是否保存", vbYesNo, "保存提示") If t = 6 Then
flags1 = True
If Timer1.Interval = 1000 Then
Open "C:\Users\Administrator\Desktop\打地鼠\primary.dat" For Append As #1 '写操作
Print #1, Text1.Text + " " + Format(Date, "M/d/yy") Close #1
ElseIf Timer1.Interval = 500 Then
Open "C:\Users\Administrator\Desktop\打地鼠\intermediate.dat" For Append As #2
Print #2, Text1.Text + " " + Format(Date, "M/d/yy") Close #2 Else
Open "C:\Users\Administrator\Desktop\打地鼠\advanced.dat" For Append As #3
Print #3, Text1.Text + " " + Format(Date, "M/d/yy") Close #3 End If End If End If
Call Form_Load
allnum = 0 '变化次数初始为0 oknum = 0 '打中次数初始为0 Timer1.Enabled = True pause.Enabled = True WLXZ.Enabled = True End Sub
Private Sub options_Click() Timer1.Enabled = False Form4.Show
WLXZ.Enabled = False countine.Enabled = True End Sub
Private Sub pause_Click() Dim r, g, b As Integer Timer1.Enabled = False countine.Enabled = True pause.Enabled = False WLXZ.Enabled = False
Form5.Top = Form2.Top + 700 Form5.Left = Form2.Left Form5.Show

用VB怎么做一个小游戏啊？

以下在Form1，需要一个text控件，设定MultiLine为True
ClassNames(i)返回的是类名，所以你可以用instr函数查找你需要的ATO.....
另外这个示例是以窗口标题查找的，比如我这是打开“我的电脑”就可以运行下面示例
最后说明这个是网友Seneal的，我只是引用和解释
--------------------------------------
Private
Sub
Form_Load()
GetChildWindow
FindWindow(vbNullString,
Trim("我的电脑"))
考验VB编程能力喽
一楼
.
呵呵
我也觉着那啥
.
手把手
...至少值2000
我说的是
RMB..
下面是个程序!希望有用
'定义蛇的运动速度枚举值
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()
Me.Show
Me.lblTitle = "BS贪食蛇 — (版本 " & App.Major & "." & App.Minor & "." & App.Revision & ")"
Me.Caption = Me.lblTitle.Caption
frmSplash.Show 1
End Sub
'该过程用于使窗体恢复原始大小
Private Sub Form_Resize()
If Me.WindowState <> 1 Then
Me.Caption = ""
Me.Height = 6405 '窗体高度为 6405 缇
Me.Width = 8535 '窗体宽度为 8535 缇
Me.Left = (Screen.Width - Width) \ 2
Me.Top = (Screen.Height - 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 Me.chkPause.Caption = "暂停游戏(&P)" Then
Me.tmrSnakeMove.Enabled = False
Me.tmrGameTime.Enabled = False
Me.picMoveArea.Enabled = False
Me.lblPauseLab.Visible = True
Me.chkPause.Caption = "继续游戏(&R)"
Else
Me.tmrSnakeMove.Enabled = True
Me.tmrGameTime.Enabled = True
Me.picMoveArea.Enabled = True
Me.lblPauseLab.Visible = False
Me.chkPause.Caption = "暂停游戏(&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-" & 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)
Beep
msg = MsgBox("您要退出本游戏吗？", 4 + 32, "BS贪食蛇")
Select Case msg
Case 6
End
Case 7
Me.chkWindowButton(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 Me.hwnd, 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 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 '最小化
Me.WindowState = 1
Me.chkWindowButton(1).Value = 0
Me.Caption = "BS贪食蛇 — (V-" & App.Major & "." & App.Minor & "版本)"
Case 2 '退出
Beep
msg = MsgBox("您要退出本游戏吗？", 4 + 32, "BS贪食蛇")
Select Case msg
Case 6
End
Case 7
Me.chkWindowButton(2).Value = 0
Exit Sub
End Select
End Select
End Sub
'该过程用于设置蛇运动速度的快慢
Private Sub hsbGameSpeed_Change()
Me.tmrSnakeMove.Interval = Me.hsbGameSpeed.Value
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
Me.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
Randomize
Me.picMoveArea.SetFocus
Me.picMoveArea.Cls
'确认蛇头的运动方向并获取新的位置
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
Me.picMoveArea.PSet (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
Me.picMoveArea.PSet (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贪食蛇"
Me.tmrSnakeMove.Enabled = False
Me.tmrGameTime.Enabled = False
Me.picMoveArea.Visible = False
Exit Sub
End If
'判断蛇在移动中是否碰到了自己的身体而导致游戏失败
If m_funTouchSnakeBody(g_udtSnake(SNAKEONE).Snake_CurX, g_udtSnake(SNAKEONE).Snake_CurY) Then
Beep
MsgBox "您的蛇在移动中碰到了自己的身体，游戏失败！", 0 + 16, "BS贪食蛇"
Me.tmrSnakeMove.Enabled = False
Me.tmrGameTime.Enabled = False
Me.picMoveArea.Visible = False
Exit Sub
End If
'判断蛇是否吃到了果子
If m_funEatPoint(g_udtSnake(SNAKEONE).Snake_CurX, g_udtSnake(SNAKEONE).Snake_CurY) Then
'累加玩家的得分并刷新得分显示
g_intPlayerScore = g_intPlayerScore + 1
Me.lblYourScore.Caption = g_intPlayerScore & "分"
Call m_subAddSnake '加长蛇的身体
Call m_subGetPoint '获取下一个果子的位置和颜色
Else
'绘制果子
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
'该私有子过程用于初始化游戏
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
Me.picMoveArea.Visible = True
Me.lblYourScore.Caption = g_intPlayerScore & "分"
Me.lblGameTime.Caption = g_lngGameTime & "秒"
Me.tmrSnakeMove.Interval = Me.hsbGameSpeed.Value
Me.tmrSnakeMove.Enabled = True
Me.tmrGameTime.Enabled = 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)
Me.PSet (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_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
'该自定义函数用于返回运动的蛇是否到达禁区而导致游戏失败
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_udtPoint.Point_X) <= SNAKEWIDTH And Abs(SnakeY - g_udtPoint.Point_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