vb简单小游戏代码
1. 求一个VB 小游戏代码 越简单越好谁帮忙写一个 网站上复制的不要
Private
Sub
Form_Click()
Dim
p
As
POINTAPI
Dim
Px
As
Integer
Dim
Py
As
Integer
Call
GetCursorPos(p)
Px
=
CInt(ScaleWidth
*
Rnd)
Py
=
CInt(ScaleHeight
*
Rnd)
If
Px
+
500
>
ScaleWidth
Then
Px
=
Px
-
550
ElseIf
Px
-
500
<
0
Then
Px
=
Px
+
550
End
If
If
Py
+
500
>
ScaleHeight
Then
Py
=
Py
-
950
ElseIf
Py
-
500
<
0
Then
Py
=
Py
+
950
End
If
If
Val(p.x)
<=
(Px
+
40)
And
Val(p.x)
>
(Px
-
40)
And
Val(p.y)
<=
(Py
+
40)
And
Val(p.y)
>
(Py
-
40)
Then
StatusBar1.Panels(1).Text
=
CStr(Val(StatusBar1.Panels(1).Text)
+
1)
End
If
Call
Pdraw(Px,
Py)
End
Sub
Sub
Pdraw(Px
As
Integer,
Py
As
Integer)
Form1.Cls
Circle
(Px,
Py),
50,
RGB(255,
0,
0)
Circle
(Px,
Py),
200,
RGB(0,
0,
0)
Circle
(Px,
Py),
300,
RGB(0,
0,
0)
Circle
(Px,
Py),
400,
RGB(0,
0,
0)
Circle
(Px,
Py),
500,
RGB(0,
0,
0)
End
Sub
一个鼠标打靶的小游戏，代码是自己写的！但是程序有一点不如人意，不能显示打靶的分数！对VB也是不很懂，对ASP比较熟悉了。
2. 介绍一个VB小的有趣的程序代码
'万花筒程序
'粘贴下面代码即可,不用添加任何控件
Dimr&,r1&,t&,a1!,a2!,xb!,yb!,s!,b#
PrivateSubForm_Load()
Me.Width=4500:Me.Height=4500
Me.Move(Screen.Width-Me.Width)\2,(Screen.Height-Me.Height)\2
Me.AutoRedraw=True
Me.Caption="CBM666的万花筒"
SetTimer1=Controls.Add("vb.timer","Timer1")
Timer1.Interval=10
EndSub
PrivateSubTimer1_Timer()
Randomize
r=340*Rnd
Ifr<>0Then
r1=500
s=r*Rnd
b=RGB(256*Rnd,256*Rnd,256*Rnd)
Fort=1To10000
a1=t*3.1415926/180
a2=(r1/r)*a1
xb=500+(-(r1-r)*Cos(a1)-s*Cos(a2-a1)+420)*4
yb=500+((r1-r)*Sin(a1)-s*Sin(a2-a1)+380)*4
Me.PSet(xb,yb),b
Nextt
EndIf
EndSub
3. 用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
4. 用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
5. vb小游戏源代码
Rem 窗体创建三个单选框按钮，Option1、Option2、Option3。
小游戏是一个较模糊的概念，它是相对于体积庞大的单机游戏及网络游戏而言的，泛指所有体积较小、玩法简单的游戏，通常这类游戏以休闲益智类为主，有单机版有网页版，在网页上嵌入的多为FLASH格式。
当下小游戏主要是指在线玩的flash版本游戏，统称小游戏，其实小游戏还包含单机游戏，小型游戏机等。一般游戏大小小于10m的游戏都统称为小游戏，一些街机类小游戏。因其游戏安装简便，耐玩性强，无依赖性而广受白领及小朋友的喜爱。
小游戏”这个词的型含义其实很简单，它不是一些大的游戏，不必花费更多的时间和精力。
小游戏是原始的游戏娱乐方式，小游戏本身是为了叫人们在工作，学习后的一种娱乐、休闲的一种方式，不是为了叫玩家为之花费金钱、花费精力，更不是叫玩家为他痴迷。
小游戏也可以理解为“Flash游戏”，是以SWF为后缀的游戏的总称.这些游戏是通过Flash软件和 Flash 编程语言 Flash ActionScript 制作而成。
由于Flash是矢量软件，所以小游戏放大后几乎不影响画面效果。Flash小游戏是一种新兴起的游戏形式，以游戏简单，操作方便，绿色，无需安装，文件体积小等优点渐渐被广大网友喜爱。
6. 急！！vb简易的小游戏代码，不要太复杂，不过石头剪刀布那种就算了
简易三国志
创建9个command，1个timer，时间20000,9个text，6个farm。
布置如图
代码如下
PrivateSubForm_Load()
Text1.Text="100"'我方剩余士兵
Text2.Text="170"'对方剩余士兵
Text3.Text="180"'对方剩余士兵
Text4.Text="200"'对方剩余士兵
Text5.Text="500"'金钱
Text6.Text="170"'武将血量
Text7.Text="120"'武将血量
Text8.Text="150"'武将血量
Text9.Text="151"'武将血量
EndSub
PrivateSubcommand1_click()
IfText1.Text<"0"OrText6.Text<"0"Then
MsgBox"无法攻击！"
Else:
Do
Text1.Text=Text1.Text-5
Text2.Text=Text2.Text-10
Text6.Text=Text6.Text-10'你的攻击力暂定为200
Text7.Text=Text7.Text-5'你的攻击力暂定为200
LoopUntilText2.Text="0"OrText7.Text="0"
MsgBox"本轮进攻胜利！"
Text5.Text=Text5.Text+500
EndIf
EndSub
PrivateSubcommand2_click()
IfText1.Text<"0"OrText6.Text<"0"Then
MsgBox"无法攻击！"
Else:
Do
Text1.Text=Text1.Text-10
Text3.Text=Text3.Text-10
Text6.Text=Text6.Text-10'你的攻击力暂定为200
Text8.Text=Text8.Text-10
LoopUntilText3.Text="0"OrText7.Text="0"
MsgBox"本轮进攻胜利！"
Text5.Text=Text5.Text+300
EndIf
EndSub
PrivateSubcommand3_click()
IfText1.Text<"0"OrText6.Text<"0"Then
MsgBox"无法攻击！"
Else:
Do
Text1.Text=Text1.Text-20
Text4.Text=Text4.Text-10
Text6.Text=Text6.Text-10'你的攻击力暂定为200
Text9.Text=Text9.Text-10
LoopUntilText4.Text="0"OrText7.Text="0"
MsgBox"本轮进攻胜利！"
Text5.Text=Text5.Text+700
EndIf
EndSub
PrivateSubcommand4_click()
Text1.Text=Text1.Text+100
Text5.Text=Text5.Text-50
IfText5.Text="0"Then
MsgBox"没钱了！"
IfText1.Text="0"Then
MsgBox"没兵了！"
EndIf
EndIf
EndSub
PrivateSubcommand5_click()
Text6.Text=Text1.Text+300
Text5.Text=Text5.Text-100
IfText5.Text="0"Then
MsgBox"没钱了！"
IfText6.Text="0"Then
MsgBox"没血了！"
EndIf
EndIf
EndSub
PrivateSubcommand6_click()
Text6.Text=Text1.Text+1000
Text5.Text=Text5.Text-500
IfText5.Text="0"Then
MsgBox"没钱了！"
IfText6.Text="0"Then
MsgBox"没可买的了！"
EndIf
EndIf
EndSub
PrivateSubcommand7_click()
MsgBox"城市名；洛阳黄金500兵马170守城大将张飞！"
EndSub
PrivateSubcommand8_click()
MsgBox"城市名；长安黄金400兵马180守城大将孙权！"
EndSub
PrivateSubcommand9_click()
MsgBox"城市名；合肥黄金700兵马200守城大将姜维！"
EndSub
PrivateSubIfTimer1="0"Then
MsgBox"台风来啦！"
Text1.Text=Text1.Text-100
Text5.Text=Text5.Text-100
EndSub
7. 诚征vb小游戏代码
贪吃蛇
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 <> 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
8. vb小游戏代码 急求。。。。。
Option Explicit
'五子棋程序 人机对战版本
'需要2个Label控件 2个CommandButton控件
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
'Dim PlayStep() As String '记录棋谱的数组
'Dim Label2Cap As String
Private Const BoxL As Single = 50, BoxT As Single = 50, BoxW As Single = 25, BoxN As Integer = 18
Dim Table() As Long '棋盘(0-BoxN,0-BoxN) 0-空 1-黑子 2-白子
Dim PsCore() As Long '定义当前玩家桌面空格的分数
Dim CsCore() As Long '定义当前电脑桌面空格的分数
Dim pWin() As Boolean '定义玩家的获胜组合
Dim cWin() As Boolean '定义电脑的获胜组合
Dim pFlag() As Boolean '定义玩家的获胜组合标志
Dim cFlag() As Boolean '定义电脑的获胜组合标志
Dim ThePlayFlag As Boolean '定义游戏有效标志
Private Sub Command1_Click()
If Not ThePlayFlag Then Call InitPlayEnvironment: Exit Sub
If MsgBox("本局还没有下完，是否重新开始？(Y/N)", vbYesNo) = vbNo Then Exit Sub
Call InitPlayEnvironment
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Form_Load()
MsgBox "五子棋之人机对战系统，作者：杨海", vbOKOnly, "杨海作品"
Dim i As Long, lw As Long, lh As Long
'Label2Cap = "000 黑方 行 00 列 00"
Me.Width = 10815: Me.Height = 8200: Me.Caption = "五子棋 - 人机对战 作者：卢霞": Me.Show
lw = Me.Width \ Screen.TwipsPerPixelX: lh = Me.Height \ Screen.TwipsPerPixelY
SetWindowRgn Me.hWnd, CreateRoundRectRgn(0, 0, lw, lh, 10, 10), True
With Label1
.Alignment = vbCenter: .FontSize = 12: .FontBold = True
.ForeColor = vbRed: .BackStyle = 0: .AutoSize = True: .Move 8910, 510
End With
Label2.AutoSize = True: Label2.WordWrap = True
Label2.BackStyle = 0: Label2.Move 8040, 1050, 2280
Command1.Move 8025, 7035, 1020, 435: Command1.Caption = "再来一局"
Command2.Move 9300, 7035, 1020, 435: Command2.Caption = "不玩了"
Call DrawChessBoard: Me.FillStyle = 0: Call InitPlayEnvironment
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
End
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim iRow As Long, iCol As Long, i As Long, k As Long, t As String
If Not ThePlayFlag Then Exit Sub
If Button = vbLeftButton Then '左键下棋
iRow = -1: iCol = -1
For i = 0 To BoxN '鼠标必须落在交叉点 半径10以内 若是则给出行列号
If (Y + 10) > (BoxT + i * BoxW) And (Y - 10) <= (BoxT + i * BoxW) Then iRow = i
If (X + 10) > (BoxL + i * BoxW) And (X - 10) <= (BoxL + i * BoxW) Then iCol = i
Next
If (iRow = -1) Or (iCol = -1) Then Beep: Exit Sub
If Table(iCol, iRow) > 0 Then Exit Sub
Table(iCol, iRow) = 2: Label1.Caption = "下一步 黑方"
Me.FillColor = vbWhite: Me.Circle (iCol * BoxW + BoxT, iRow * BoxW + BoxL), 8
For i = 0 To UBound(cWin, 3)
If cWin(iCol, iRow, i) = True Then cFlag(i) = False
Next
Call CheckWin: Call DianNao '检查当前玩家是否获胜 调用电脑算法
End If
End Sub
Public Sub InitPlayEnvironment()
'*****************************************************************************
' 模块名称: InitPlayEnvironment [初始化过程]
'
' 描述: 1. 设置背景音乐。 2. 设置游戏状态有效。
' 3. 初始化游戏状态标签。 4. 直接指定电脑的第一步走法。
' 5. 初始化基本得分桌面。 6. 电脑和玩家获胜标志初始化。
' 7. 初始化所有获胜组合。 8. 重新设定玩家的获胜标志。
'*****************************************************************************
Dim i As Long, j As Long, m As Long, n As Long
ThePlayFlag = True: Label1.Caption = "下一步 白方": Label2.Caption = ""
Me.FillColor = vbBlack: Me.FillStyle = 0: Me.AutoRedraw = True
Me.Cls: Me.Circle (9 * BoxW + BoxL, 9 * BoxW + BoxT), 8
ReDim Table(0 To BoxN, 0 To BoxN) As Long
ReDim pFlag(NumsWin(BoxN + 1) - 1) As Boolean
ReDim cFlag(UBound(pFlag)) As Boolean
ReDim PsCore(BoxN, BoxN) As Long, CsCore(BoxN, BoxN) As Long
ReDim pWin(BoxN, BoxN, UBound(pFlag)) As Boolean
ReDim cWin(BoxN, BoxN, UBound(pFlag)) As Boolean
For i = 0 To UBound(pFlag): pFlag(i) = True: cFlag(i) = True: Next
Table(9, 9) = 1 '假定电脑先手 并下了(9, 9)位 将其值设为1
'******** 初始化获胜组合 ****************************************
For i = 0 To BoxN: For j = 0 To BoxN - 4
For m = 0 To 4
pWin(j + m, i, n) = True: cWin(j + m, i, n) = True
Next
n = n + 1
Next: Next
For i = 0 To BoxN: For j = 0 To BoxN - 4
For m = 0 To 4
pWin(i, j + m, n) = True: cWin(i, j + m, n) = True
Next
n = n + 1
Next: Next
For i = 0 To BoxN - 4: For j = 0 To BoxN - 4
For m = 0 To 4
pWin(j + m, i + m, n) = True: cWin(j + m, i + m, n) = True
Next
n = n + 1
Next: Next
For i = 0 To BoxN - 4: For j = BoxN To 4 Step -1
For m = 0 To 4
pWin(j - m, i + m, n) = True: cWin(j - m, i + m, n) = True
Next
n = n + 1
Next: Next
'******** 初始化获胜组合结束 *************************************
For i = 0 To UBound(pWin, 3) '由于电脑已下了(9, 9)位 所以需要重新设定玩家的获胜标志
If pWin(9, 9, i) = True Then pFlag(i) = False
Next
End Sub
Public Function DrawChessBoard() As Long
'容器的(BoxL, BoxT)为左上角坐标画一个 BoxN*BoxN, 每格边长为 BoxW 象素的棋盘
Dim i As Long, j As Long, cx As Long, cy As Long
Me.ScaleMode = 3: Me.FillStyle = 1: Me.AutoRedraw = True: Me.Cls
For i = 0 To BoxN '画棋盘
Me.Line (BoxL + i * BoxW, BoxT)-(BoxL + i * BoxW, BoxT + BoxN * BoxW)
Me.Line (BoxL, BoxT + i * BoxW)-(BoxL + BoxN * BoxW, BoxT + i * BoxW)
Me.CurrentX = BoxL + i * BoxW - IIf(i > 9, 6, 2)
Me.CurrentY = BoxT - 20: Me.Print Format(i)
Me.CurrentX = BoxL - IIf(i > 9, 23, 20)
Me.CurrentY = BoxT + i * BoxW - 6: Me.Print Format(i)
Next
For i = 3 To 16 Step 6: For j = 3 To 16 Step 6 '画小标志
cx = BoxL + j * BoxW - 3: cy = BoxT + i * BoxW - 3
Me.Line (cx, cy)-(cx + 6, cy + 6), , B
Next: Next
Me.AutoRedraw = False: Set Me.Picture = Me.Image
End Function
Public Sub CheckWin()
'*****************************************************************************
' 模块名称: CheckWin [获胜检查算法]
'
' 描述: 1. 检查是否和棋。 2. 检查电脑是否获胜。 3. 检查玩家是否获胜。
'*****************************************************************************
Dim i As Long, j As Long, k As Long, m As Long, n As Long
Dim cA As Long, pA As Long, cN As Long
For i = 0 To UBound(cFlag): cN = IIf(cFlag(i) = False, cN + 1, cN): Next
If cN = UBound(cFlag) - 1 Then '设定和棋规则
Label1.Caption = "双方和棋！": ThePlayFlag = False: Exit Sub
End If
For i = 0 To UBound(cFlag) '检查电脑是否获胜
If cFlag(i) = True Then
cA = 0: For j = 0 To BoxN: For k = 0 To BoxN
If Table(j, k) = 1 And cWin(j, k, i) = True Then cA = cA + 1
Next: Next
If cA = 5 Then Label1.Caption = "电脑获胜！": ThePlayFlag = False: Exit Sub
End If
Next
For i = 0 To UBound(pFlag) '检查玩家是否获胜
If pFlag(i) = True Then
pA = 0: For j = 0 To BoxN: For k = 0 To BoxN
If Table(j, k) = 2 And pWin(j, k, i) = True Then pA = pA + 1
Next: Next
If pA = 5 Then Label1.Caption = "玩家获胜！": ThePlayFlag = False: Exit Sub
End If
Next
End Sub
Public Sub DianNao()
'*****************************************************************************
' 模块名称: DianNao [电脑算法]
' 描述: 1. 初始化赋值系统。 2. 赋值加强算法。 3. 计算电脑和玩家的最佳攻击位。
' 4. 比较电脑和玩家的最佳攻击位并决定电脑的最佳策略。 5. 执行检查获胜函数。
'*****************************************************************************
Dim i As Long, j As Long, k As Long, m As Long, n As Long
Dim Dc As Long, cAb As Long, pAb As Long
ReDim PsCore(BoxN, BoxN) As Long, CsCore(BoxN, BoxN) As Long '初始化赋值数组
'******** 电脑加强算法 ********
For i = 0 To UBound(cFlag)
If cFlag(i) = True Then
cAb = 0
For j = 0 To BoxN: For k = 0 To BoxN
If Table(j, k) = 1 And cWin(j, k, i) = True Then cAb = cAb + 1
Next: Next
Select Case cAb
Case 3
For m = 0 To BoxN: For n = 0 To BoxN
If Table(m, n) = 0 And cWin(m, n, i) = True Then CsCore(m, n) = CsCore(m, n) + 5
Next: Next
Case 4
For m = 0 To BoxN: For n = 0 To BoxN
If Table(m, n) = 0 And cWin(m, n, i) = True Then
Table(m, n) = 1: Label1.Caption = "下一步 白方"
Me.FillColor = vbBlack: Me.Circle (m * BoxW + BoxL, n * BoxW + BoxT), 8
For Dc = 0 To UBound(pWin, 3)
If pWin(m, n, Dc) = True Then pFlag(Dc) = False: Call CheckWin: Exit Sub
Next
End If
Next: Next
End Select
End If
Next
For i = 0 To UBound(pFlag)
If pFlag(i) = True Then
pAb = 0
For j = 0 To BoxN: For k = 0 To BoxN
If Table(j, k) = 2 And pWin(j, k, i) = True Then pAb = pAb + 1
Next: Next
Select Case pAb
Case 3
For m = 0 To BoxN: For n = 0 To BoxN
If Table(m, n) = 0 And pWin(m, n, i) = True Then PsCore(m, n) = PsCore(m, n) + 30
Next: Next
Case 4
For m = 0 To BoxN: For n = 0 To BoxN
If Table(m, n) = 0 And pWin(m, n, i) = True Then
Table(m, n) = 1: Label1.Caption = "下一步 白方"
Me.FillColor = vbBlack: Me.Circle (m * BoxW + BoxL, n * BoxW + BoxT), 8
For Dc = 0 To UBound(pWin, 3)
If pWin(m, n, Dc) = True Then pFlag(Dc) = False: Call CheckWin: Exit Sub
Next
End If
Next: Next
End Select
End If
Next
'******** 电脑加强算法结束 ********
'******** 赋值系统 ****************
For i = 0 To UBound(cFlag)
If cFlag(i) = True Then
For j = 0 To BoxN: For k = 0 To BoxN
If (Table(j, k) = 0) And cWin(j, k, i) Then
For m = 0 To BoxN: For n = 0 To BoxN
If (Table(m, n) = 1) And cWin(m, n, i) Then CsCore(j, k) = CsCore(j, k) + 1
Next: Next
End If
Next: Next
End If
Next
For i = 0 To UBound(pFlag)
If pFlag(i) = True Then
For j = 0 To BoxN: For k = 0 To BoxN
If (Table(j, k) = 0) And pWin(j, k, i) Then
For m = 0 To BoxN: For n = 0 To BoxN
If (Table(m, n) = 2) And pWin(m, n, i) Then PsCore(j, k) = PsCore(j, k) + 1
Next: Next
End If
Next: Next
End If
Next
'******** 赋值系统结束 ************
'******** 分值比较算法 ************
Dim a As Long, b As Long, c As Long, d As Long
Dim cS As Long, pS As Long
For i = 0 To BoxN: For j = 0 To BoxN
If CsCore(i, j) > cS Then cS = CsCore(i, j): a = i: b = j
Next: Next
For i = 0 To BoxN: For j = 0 To BoxN
If PsCore(i, j) > pS Then pS = PsCore(i, j): c = i: d = j
Next: Next
If cS > pS Then
Table(a, b) = 1: Label1.Caption = "下一步 白方"
Me.FillColor = vbBlack: Me.Circle (a * BoxW + BoxL, b * BoxW + BoxT), 8
For i = 0 To UBound(pWin, 3)
If pWin(a, b, i) = True Then pFlag(i) = False
Next
Else
Table(c, d) = 1: Label1.Caption = "下一步 白方"
Me.FillColor = vbBlack: Me.Circle (c * BoxW + BoxL, d * BoxW + BoxL), 8
For i = 0 To UBound(pWin, 3)
If pWin(c, d, i) = True Then pFlag(i) = False
Next
End If
'******** 分值比较算法结束 ********
Call CheckWin
End Sub
Public Function NumsWin(ByVal n As Long) As Long
'根据输入的棋盘布局 n*n 计算总共有多少种获胜组合
'假定棋盘为 10 * 10 相应的棋盘数组就是 Table(9, 9)
'水平方向 每一列获胜组合是6 共10列 6*10=60
'垂直方向 每一行获胜组合是6 共10行 8*10=60
'正对角线方向 6 + (5 + 4 + 3 + 2 + 1) * 2 = 36
'反对角线方向 6 + (5 + 4 + 3 + 2 + 1) * 2 = 36
'总的获胜组合数为 60 + 60 + 36 + 36 = 192
Dim i As Long, t As Long
For i = n - 5 To 1 Step -1: t = t + i: Next
NumsWin = 2 * (2 * t + n - 4) + 2 * n * (n - 4)
End Function
9. 求VB打字母练习小游戏的代码
'窗体上添加一个按钮和一个Frame,然后在Frame里添加三个标签
Dim speed As Integer
Sub init()
Label2.Caption = Chr(Int(Rnd * 26) + 49)
speed = 100
Label2.Left = Int(Rnd * Frame1.Width)
Label2.Top = Frame1.Top '
End Sub
Private Sub Command1_Click()
init
Timer1.Interval = 1000
Timer2.Interval = 1000
Timer1.Enabled = True
Timer2.Enabled = True
Command1.Visible = False
Label3.Caption = 100
Label1.Caption = 0
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If Chr(KeyAscii) = Label2.Caption Then
init
Label1.Caption = Val(Label1.Caption) + 1
End If
End Sub
Private Sub Form_Load()
Randomize
Timer1.Enabled = False
Timer2.Enabled = False
End Sub
Private Sub Timer1_Timer()
Label2.Top = Label2.Top + speed
If Label2.Top > Frame1.Height Then
init
End If
End Sub
Private Sub Timer2_Timer()
Label3.Caption = Val(Label3.Caption) - 1
If Val(Label3.Caption) <= 0 Then
Timer1.Enabled = False
Timer2.Enabled = False
Label2.Caption = ""
Select Case Val(Label1.Caption)
Case Is < 60
MsgBox vbCrLf + "你真菜!努力吧!"
Case Is >= 60
MsgBox vbCrLf + "恩~！还可以有进步!"
Case Is >= 100
MsgBox vbCrLf + "哈```满分!"
Case Is > 150
MsgBox vbCrLf + "好厉害啊`!"
End Select
End If
End Sub