vb小游戏
‘壹’ 用VB帮忙做一个小游戏
'添加一个名为label1的标签控件，并将其index设为0；再添加一个名为command1的按钮控件
Dima(1To9)AsBoolean
DimwinAsBoolean,beginAsBoolean,haveloadAsBoolean,startAsBoolean
PrivateSubCommand1_Click()
start=True:begin=False
Fori=1To9
a(i)=False
Nexti
Form_Load
EndSub
PrivateSubForm_Load()
a(9)=True
Label1(0).Visible=False
Me.Height=4400
Me.Width=4000
Scale(0,0)-(3,3.3)
Ifhaveload=FalseThen
haveload=True:start=True
Command1.Top=3:Command1.Left=2
Command1.Width=1:Command1.Height=0.3
Command1.Caption="开始"
Fori=1To9
LoadLabel1(i)
Nexti
EndIf
Fori=1To9
Label1(i).Height=1
Label1(i).Width=1
Label1(i).Visible=True
Label1(i).Top=(i-1)3
Label1(i).Left=(i-1)Mod3
Label1(i).Caption=Str(i)
Label1(i).BackColor=QBColor(i)
Label1(i).FontBold=True
Label1(i).FontSize=40
Nexti
Label1(9).Caption="":Label1(9).BackColor=vbWhite
Randomize
Fori=1To500
r%=Int(9*Rnd)+1
CallLabel1_Click(r)
Nexti
begin=True
EndSub
PrivateSubLabel1_Click(indexAsInteger)
Dimx1AsInteger,y1AsInteger
Ifstart=TrueThen
Ifa(index)=FalseThen
x1=(index-1)Mod3:y1=(index-1)3
Ifx1-1>-0.2Then
Ifa(x1+y1*3)=TrueThenCallyidong(x1+y1*3,index)
EndIf
Ifx1+1<2.2Then
Ifa(x1+y1*3+2)=TrueThenCallyidong(x1+y1*3+2,index)
EndIf
Ify1-1>-0.2Then
Ifa(x1+1+(y1-1)*3)=TrueThenCallyidong(x1+(y1-1)*3+1,index)
EndIf
Ify1+1<2.2Then
Ifa(x1+1+(y1+1)*3)=TrueThenCallyidong(x1+1+(y1+1)*3,index)
EndIf
EndIf
win=True
Fori=1To8
IfVal(Label1(i).Caption)<>iThenwin=False
Nexti
Ifwin=TrueAndbegin=TrueThenMsgBox("恭喜你成功了"):begin=False:start=False
EndIf
EndSub
Subyidong(x,index)
Label1(0).Caption=Label1(index).Caption
Label1(index).Caption=Label1(x).Caption
Label1(x).Caption=Label1(0).Caption
a(index)=True:a(x)=False
Label1(0).BackColor=Label1(index).BackColor
Label1(index).BackColor=Label1(x).BackColor
Label1(x).BackColor=Label1(0).BackColor
EndSub
‘贰’ 用vb做一个小游戏 希望每一步有详细解释
做个贪吃蛇，flppy bird，纵向像素赛车，推箱子，水果机
这些都不难，运用到一些特殊游戏算法，
贪吃蛇：创建pictureBox控件数组, 然后加身子就load picture1(picture1.UBound+1)
在声明一个动态数2d数组，每个身子都有一个X，Y值每移动一次贪吃蛇，头部先走一步后面的身子就向前一个身子的位置X,Y移动
flppy bird：运用到加速度，重力物理学，以及柱子的碰撞检测
纵向赛车：随机下来几个pictureBox，如果有方块的纵坐标超过了一定量，那就再从顶部开始下滑（呈现赛车相对几个障碍物向上走的视觉效应）
推箱子：这个实现起来不容易，要把每一次箱子的位置映像成2D数组，然后根据2d数组坐标判断对的箱子，箱子和箱子，箱子和墙，箱子和目标，hero和箱子的几种关系要搞清，谁是主动，谁是被动，谁碰到谁再碰到谁就不能再碰哈哈
水果机：相对没什么技术含量，计数器累加再弄一个小球在屏幕上转圈滚动，滚动到事先生成的随机数等于累加的数字时，停止小球的滚动，停在了那里就用计数变量mod加分类别，最终该得多少分，输出在text里面。。
‘叁’ 用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()
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
‘肆’ 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小游戏源代码
Rem 窗体创建三个单选框按钮，Option1、Option2、Option3。
小游戏是一个较模糊的概念，它是相对于体积庞大的单机游戏及网络游戏而言的，泛指所有体积较小、玩法简单的游戏，通常这类游戏以休闲益智类为主，有单机版有网页版，在网页上嵌入的多为FLASH格式。
当下小游戏主要是指在线玩的flash版本游戏，统称小游戏，其实小游戏还包含单机游戏，小型游戏机等。一般游戏大小小于10m的游戏都统称为小游戏，一些街机类小游戏。因其游戏安装简便，耐玩性强，无依赖性而广受白领及小朋友的喜爱。
小游戏”这个词的型含义其实很简单，它不是一些大的游戏，不必花费更多的时间和精力。
小游戏是原始的游戏娱乐方式，小游戏本身是为了叫人们在工作，学习后的一种娱乐、休闲的一种方式，不是为了叫玩家为之花费金钱、花费精力，更不是叫玩家为他痴迷。
小游戏也可以理解为“Flash游戏”，是以SWF为后缀的游戏的总称.这些游戏是通过Flash软件和 Flash 编程语言 Flash ActionScript 制作而成。
由于Flash是矢量软件，所以小游戏放大后几乎不影响画面效果。Flash小游戏是一种新兴起的游戏形式，以游戏简单，操作方便，绿色，无需安装，文件体积小等优点渐渐被广大网友喜爱。
‘陆’ 如何用vb写一个这样的小游戏
把代码复制到空窗体中按F5运行即可。
Option 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
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
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.ScaleWidth = 24
Me.ScaleHeight = 24
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 lt;; 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(;游戏结束，点“是”重新开始游戏，点“否”;, vbYesNo, ;贪吃蛇;) = vbYes Then
ChuShiHua
Else
End
End If
End Sub
Private Sub ChuShiHua()
Me.Cls
Timer1.Enabled = True
Timer1.Interval = 200
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
应该就是这个了
‘柒’ 求VB小游戏，简单一点，越简单越好
数字排序小游戏
Option Explicit
Dim Label2X As Integer '记录标签控件数组中要移动的标签控件左上角X的位置
Dim Label2Y As Integer '记录标签控件数组中要移动的标签控件左上角Y的位置
'让标签数组中的每个标签控件上显示的数字是随机的，无重复的
Private Sub Init()
Randomize
Dim a(7) As Integer
Dim i As Integer, k As Integer
Label1.Caption = ""
For i = 0 To 7
a(i) = i
Next
For i = 0 To 7
k = Int(Rnd * 8)
Do While a(k) = -1 'a(k)=-1表示该数组元素对应的数字已经被使用过了
k = Int(Rnd * 8) '重新生成k的值，直到a(k)的值不等于-1
Loop
Label2(i).Caption = Trim(Str(a(k)))
a(k) = -1 'a(k)的值已经使用了，不能再用，重新赋值为-1与其他的元素值相区别
Next i
End Sub
Private Sub Command1_Click()
Dim x As Integer, y As Integer
Dim z As Integer
Init
Picture1.Enabled = True
'让空白标签Label1出现的位置随机
Randomize
'记录下空白标签Label1的位置
x = Label1.Left
y = Label1.Top
z = Int(Rnd * 8)
'将空白标签Label1和标签控件数组任一控件交换位置
Label1.Move Label2(z).Left, Label2(z).Top
Label2(z).Move x, y
Command1.Enabled = False
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Form_Load()
Dim i As Integer
Picture1.Enabled = False
'在标签中显示游戏说明信息
Label3.Caption = "如左图所示，将数字按0-7顺" & vbCrLf & vbCrLf & "序依次排列，即取得胜利。"
'在标签中显示排列规则后的数字顺序
Label1.Caption = 0
For i = 0 To 6
Label2(i).Caption = i + 1
Next
End Sub
Private Sub Label1_DragDrop(Source As Control, x As Single, y As Single)
Dim Label1X As Integer '记录空白控件Label1左上角X的位置
Dim Label1Y As Integer '记录空白控件Label1左上角Y的位置
Dim flag(3) As Boolean
'获取空白控件Label1的位置
Label1X = Label1.Left
Label1Y = Label1.Top
'要移动的控件位于空白控件Label1的正左侧
flag(0) = (Label2X = Label1X - Source.Width) And (Label2Y = Label1Y)
'要移动的控件位于空白控件Label1的正右侧
flag(1) = (Label2X = Label1X + Source.Width) And (Label2Y = Label1Y)
'要移动的控件位于空白控件Label1的正上方
flag(2) = (Label2X = Label1X) And (Label2Y = Label1Y - Source.Height)
'要移动的控件位于空白控件Label1的正下方
flag(3) = (Label2X = Label1X) And (Label2Y = Label1Y + Source.Height)
If flag(0) Or flag(1) Or flag(2) Or flag(3) Then
Label1.Move Label2X, Label2Y
Source.Move Label1X, Label1Y
End If
Win
End Sub
Private Sub Label2_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then '如果按下鼠标左键
'记录下要拖动控件的位置
Label2X = Label2(Index).Left
Label2Y = Label2(Index).Top
Label2(Index).Drag 1 '启动拖动操作
End If
End Sub
Private Sub Label2_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
Label2(Index).Drag 2 '结束拖动操作
End Sub
Private Sub Win()
Dim winner As Integer
Dim i As Integer
Dim answer As Integer
'对于给定的标签控件数组中的任一标签控件，可以落在符合要求(对应位置应显示对应数字）
'的八个位置中的任一位置
'利用循环语句对标签控件数组中的每个标签控件进行检查，如果其落在某一符号要求的位置，
'则变量winner的值加1，如果所有标签控件都落在符号要求的位置，则变量winner的值应为8
For i = 0 To 7
If Label2(i).Left = 0 And Label2(i).Top = 0 And _
Label2(i).Caption = 0 Then
winner = winner + 1
ElseIf Label2(i).Left = Label2(i).Width And Label2(i).Top = 0 And _
Label2(i).Caption = 1 Then
winner = winner + 1
ElseIf Label2(i).Left = 2 * Label2(i).Width And Label2(i).Top = 0 And _
Label2(i).Caption = 2 Then
winner = winner + 1
ElseIf Label2(i).Left = 0 And Label2(i).Top = Label2(i).Height And _
Label2(i).Caption = 3 Then
winner = winner + 1
ElseIf Label2(i).Left = Label2(i).Width And Label2(i).Top = Label2(i).Height And _
Label2(i).Caption = 4 Then
winner = winner + 1
ElseIf Label2(i).Left = 2 * Label2(i).Width And Label2(i).Top = Label2(i).Height And _
Label2(i).Caption = 5 Then
winner = winner + 1
ElseIf Label2(i).Left = 0 And Label2(i).Top = 2 * Label2(i).Height And _
Label2(i).Caption = 6 Then
winner = winner + 1
ElseIf Label2(i).Left = Label2(i).Width And Label2(i).Top = 2 * Label2(i).Height And _
Label2(i).Caption = 7 Then
winner = winner + 1
End If
Next i
If winner = 8 Then
MsgBox " 恭喜您，胜利了！", 0 + 64 + 0, "提示"
Picture1.Enabled = False
answer = MsgBox("还继续吗？", 4 + 32 + 0, "提示")
If answer = vbYes Then
Command1.Enabled = True
Else
End
End If
End If
End Sub
弹球游戏
Dim x_step As Integer
Dim y_step As Integer
Private Sub command1_Click()
If Timer1.Enabled = True Then
Timer1.Enabled = False
Else
Timer1.Enabled = True
End If
If command1.Caption = "暂停" Then
command1.Caption = "继续"
Else
command1.Caption = "暂停"
End If
End Sub
Private Sub Form_Load()
x_step = 200
y_step = 200
End Sub
Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 37 Then
If Line1.X1 < 0 Then
Line1.X1 = 0: Line1.X2 = 2000
Else
Line1.X1 = Line1.X1 - 100: Line1.X2 = Line1.X2 - 100
End If
End If
If KeyCode = 39 Then
If Line1.X1 > Picture1.Width Then
Line1.X1 = Picture1.Width - 2000: line2.X2 = Picture.Width
Else
Line1.X1 = Line1.X1 + 100: Line1.X2 = Line1.X2 + 100
End If
End If
End Sub
Private Sub Timer1_Timer()
If Shape1.Top < 0 Then
Shape1.Top = 0: y_step = -y_step
End If
If Shape1.Left < 0 Then
Shape1.Left = 0
x_step = -x_step
End If
If Shape1.Left > Picture1.Width - Shape1.Width Then
Shape1.Left = Picture1.Width - Shape1.Width
x_step = -x_step
End If
If Shape1.Left >= Line1.X1 And Shape1.Left <= Line1.X2 And Shape1.Top >= Line1.Y1 - Shape1.Height Then
Shape1.Top = Line1.Y1 - Shape1.Height
y_step = -y_step * 1.01
x_step = x_step * 1.01
Label2.Caption = Label2.Caption + 1
End If
Shape1.Top = Shape1.Top + y_step
Shape1.Left = Shape1.Left + x_step
If Shape1.Top >= Picture1.Height - Shape1.Height Then
MsgBox "游戏结束"
command1.Caption = "开始"
Timer1.Enabled = False
Shape1.Top = 1000
Label2.Caption = 0
End If
End Sub
打字游戏
Dim score As Integer
Dim speed As Integer
Dim typetime As Integer
Private Sub init()
Randomize
lblletter1.Caption = Chr(Int(Rnd * 42) + 48)
lblletter1.Left = Int(Rnd * 2800) + 1
lblletter1.Top = 0
End Sub
Private Sub init1()
Randomize
lblletter2.Caption = Chr(Int(Rnd * 25) + 97)
lblletter2.Left = Int(Rnd * 2800) + 1
lblletter2.Top = 0
End Sub
Private Sub Command1_Click()
score = Int(lblscore.Text)
init
init1
Timer1 = True
Timer2 = True
HScroll1.Enabled = False
Command1.Enabled = False
Command2.Enabled = False
HScroll1.Enabled = False
If lbltime.Text <= 0 Then
Timer1 = False
Timer2 = False
lblletter1.Caption = ""
lblletter2.Caption = ""
End If
End Sub
Private Sub Command2_Click()
typetime = InputBox("请输入打字时间。", "时间设置")
If typetime <= 0 Then
lbltime.Text = 60
End If
lbltime.Text = typetime
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If Chr(KeyAscii) = lblletter1.Caption Then
score = score + 1
lblscore.Text = score
init
End If
If Chr(KeyAscii) = lblletter2.Caption Then
score = score + 1
lblscore.Text = score
init1
End If
End Sub
Private Sub Form_Load()
Timer1.Enabled = False
Timer2.Enabled = False
lblletter1.AutoSize = True
lblletter2.AutoSize = True
lblletter1.Caption = ""
lblletter2.Caption = ""
lblscore.Text = 0
lblspeed.Caption = 100
lbltime.Text = 60
HScroll1.Max = 200
HScroll1.Min = 20
HScroll1.SmallChange = 5
HScroll1.LargeChange = 20
HScroll1.Value = 100
End Sub
Private Sub HScroll1_Change()
lblspeed.Caption = HScroll1.Value
End Sub
Private Sub Timer1_Timer()
lblletter1.Top = lblletter1.Top + lblspeed.Caption
If lblletter1.Top >= 4335 Then
Call init
End If
lblletter2.Top = lblletter2.Top + lblspeed.Caption
If lblletter2.Top >= 4335 Then
Call init1
End If
End Sub
Private Sub Timer2_Timer()
If lbltime.Text > 0 Then
lbltime.Text = lbltime.Text - 1
Else: Select Case score / (typetime / 60)
Case Is <= 40
MsgBox ("不要放弃再试一次！")
Case 40 To 80
MsgBox ("太棒了，继续努力！")
Case 80 To 120
MsgBox ("坚持下去，你将成为一个打字高手！")
Case Is > 120
MsgBox ("祝贺你！你已经是一个打字高手！")
End Select
Timer1 = False
Timer2 = False
HScroll1.Enabled = True
Command1.Enabled = True
Command2.Enabled = True
HScroll1.Enabled = True
init
init1
End If
End Sub
点灯游戏
Private Sub Form_Load()
Form1.Scale (0, 12)-(12, 0)
For i = 1 To 11
Line (1, i)-(11, i)
Line (i, 1)-(i, 11)
Next i
End Sub
Sub fill_color(X, Y)
If Point(X, Y) = vbWhite Then
Line (Int(X), Int(Y))-(Int(X + 1), Int(Y + 1)), vbBlack, BF
Else
Line (Int(X), Int(Y))-(Int(X + 1), Int(Y + 1)), vbWhite, BF
End If
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X >= 1 And X <= 11 And Y >= 1 And Y <= 11 Then
Call fill_color(X, Y)
If X >= 1 And X <= 11 And Y + 1 >= 1 And Y + 1 <= 11 Then
Call fill_color(X, Y + 1)
End If
If X >= 1 And X <= 11 And Y - 1 >= 1 And Y - 1 <= 11 Then
Call fill_color(X, Y - 1)
End If
If X + 1 >= 1 And X + 1 <= 11 And Y >= 1 And Y <= 11 Then
Call fill_color(X + 1, Y)
End If
If X - 1 >= 1 And X - 1 <= 11 And Y >= 1 And Y <= 11 Then
Call fill_color(X - 1, Y)
End If
End If
Call Form_Load
End Sub
猜数字
Dim number As Integer
Private Sub Command1_Click()
Dim guess As Integer, diff As Integer
guess = Val(Text1.Text)
If guess = -1 Then
MsgBox ("要猜的数是" & number)
Text1.Text = ""
Text1.SetFocus
Exit Sub
End If
diff = Abs(number - guess)
Select Case diff
Case 0
MsgBox ("恭喜你猜对了！")
Case 2, Is < 2
MsgBox ("接近了，再努力！")
Case 10, Is < 12
MsgBox ("有些远，再努力！")
Case Else
MsgBox ("太远了，继续努力！")
End Select
Select Case diff
Case Is <> 0
Text1.Text = ""
Text1.SetFocus
End Select
End Sub
Private Sub Form_Load()
MsgBox ("计算机产生了一个1~100之间的整数，" & Chr(10) & "请您猜出这个数是多少。" & Chr(10) & "如果输入-1，则停止猜数，并输出要猜的数。")
number = Int(100 * Rnd) + 1
End Sub
Private Sub Label1_Click()
End Sub
猜笑脸
Private Sub Command1_Click(Index As Integer)
Dim a As Integer, i As Integer
Randomize
a = Int(Rnd * 4)
Command1(a).Enabled = False
Command1(a).DisabledPicture = LoadPicture("267.gif")
If a = Index Then
Label1.Caption = "你猜对啦，真棒！"
Else
Label1.Caption = "你猜错啦，我在这哩！"
End If
For i = 0 To 3
Command1(i).Enabled = False
Next i
End Sub
Private Sub Command2_Click()
Dim i As Integer
For i = 0 To 3
Command1(i).Enabled = True
Command1(i).DisabledPicture = LoadPicture("")
Next i
Label1.Caption = "猜猜我在哪儿？"
End Sub
Private Sub Command3_Click()
End
End Sub
‘捌’ 用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()
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
‘玖’ 用vb做一个益智小游戏
对不起，上午顾着吃饭作错了，现在更改！
功能实现了细节自己设置！
Dim intI As Integer
Dim intJ As Integer
Dim intH As Integer
Dim intS(0 To 11) As Integer
Private Sub Command1_Click()
'寻找：
Dim intG As Integer
If intH + 6 > 11 Then
intG = intH - 6
Else
intG = intH + 6
End If
For intI = 0 To 11
If intI = intS(intG) Then
Image1(intI).Picture = LoadPicture(App.Path & "\" & intG & ".jpg")
End If
Next
End Sub
'在该工程同一级目录下命名0到11个图片（6张不同的图片各两份以0-5，6-11按顺序命名），且添加一个背景图片
Private Sub Form_Load()
Dim bln As Boolean
Randomize
intI = 0
Do While intI < 12
bln = False
Image1(intI).Picture = LoadPicture(App.Path & "\背景.gif")
intJ = Int(11 + 1) * Rnd
For intH = 0 To intI
If intJ = intS(intH) Then
bln = True
intI = intI - 1
Exit For
End If
Next
If bln = False Then
intS(intI) = intJ
End If
intI = intI + 1
Loop
End Sub
Private Sub Image1_Click(Index As Integer)
intH = intS(Index)
Image1(Index).Picture = LoadPicture(App.Path & "\" & intS(Index) & ".jpg")
End Sub
‘拾’ VB编写小游戏的全过程谁告诉我
开始学vb时,并不知道vb可以做出动画,后来知道通过自编的子函数delay(c的库函数中的该函数)和cls可以做出许多动画,但有一个缺点就是太耗内存,就我个人认为构思应该比编程重要，因为一旦有了一个很好的构思剩下的问题都是技术问题，而我就是喜欢发现新的问题然后再想方设法解决它，通过发现问题和解决问题我可以学到许多很有用的知识和技巧。好了，现在有了一个好的构思就开始进入程序的编制。
第一步，要做成这个游戏的话必须能使小球有一个判断性的运动，然而如何处理小球的运动呢，很显然delay&cls的方法不再适用，因为整个程序运行时不停的清屏效果将很差，所以我想到了用shape控件来替代用circle命令画的小球，接着要使小球运动起来，这个问题很简单，因为 shape控件有left和top的属性，可以通过对这两个属性的控制可以很轻松的解决小球运动问题。
第二步，将对小球进行角度控制，角度可以通过shape的属性left和top来反映，通过timer控件使小球的left和top值不断加上一个值或减去一个值，小球的left和top同时改变之后就可以对小球的角度进行控制。到这里已经可以使小球运动起来，接下来的问题就是使小球能进行判断性运动。
第三步，可以这样对小球进行判断性控制，当小球的left大于窗体的scaleleft时小球的left改变成减去一个值,以此类推,小球的高度也可以进行类似的控制,现在已经很方便的对小球进行判断性运动，到这一步程序已经算是完成了一半。
第四步，既然小球可以自由的运动了，那就可以产生这样一个想法，当小球的top和left的砖块的top和left值接近到一定的范围的条件成立时使砖块的visible为false，然后小球的top和left加上接触前相应相反的值，就可以使砖块消失同时小球改变运动轨迹，这一步的实现需要解决很多技术性问题，可以在form的load事件里定义两个变量Dwd和Dhd以及两个Boolean量为Dw和Dh，通过Dwd和Dhd来控制小球向左和向上运动，当小球和窗体的边界或和砖块的的边界接触时使Dw和Dh的值进行相应的变化，通过对该两个值的控制可以使小球进行合乎反弹角度的运动，现在程序已经初步成型。
第五步，要做成这样的一个游戏，必须有一个良好的用户界面，为了使小球能接受用户的控制，我在窗体的下边界放置了一个命令按钮，该命令按钮可以通过方向键来控制，然后再加上一些判断语句使得小球command接触时产生相应的运动，这样一个用户界面就解决了。
第六步，现在只剩下程序的最后一步，就是生成砖块的排列，砖块可以用命令按钮来替代，然后用循环语句将设置好的command控件数组在程序运行时加载进来，好了，现在已经一切完成.