用VB怎么做一个小游戏啊? 如何用vb写一个这样的小游戏
\u600e\u4e48\u7528VB\u505a\u4e00\u4e2a\u5c0f\u6e38\u620f\u505a\u7956\u739b\u522b\u770b\u6e38\u620f\u64cd\u4f5c\u7b80\u5355\uff0c\u5176\u5b9e\u7f16\u7a0b\u6d89\u53ca\u7684\u6280\u672f\u95ee\u9898\u6bd4\u8f83\u590d\u6742\u3002
\u5efa\u8baeVB\u521d\u5b66\u8005\u5b66\u4f1a\u7528PictureBox\u63a7\u4ef6\u6765\u505a\u5766\u514b\u5927\u6218\u7684\u6e38\u620f\uff0c\u5c24\u5176\u591a\u8f86\u654c\u65b9\u5766\u514b\u7528\u4e00\u4e2a\u6570\u7ec4\u6765\u63a7\u5236\u3002\u5f53\u4f60\u660e\u767d\u201c\u6570\u7ec4\u201d\u5728\u89d2\u8272\u3001\u5730\u56fe\u3001\u5b50\u5f39\u8bbe\u8ba1\u7684\u57fa\u7840\u4f5c\u7528\u65f6\uff0c\u518d\u5236\u4f5c\u7956\u739b\u7c7b\u6e38\u620f\u5c31\u77e5\u9053\u8be5\u600e\u4e48\u6837\u505a\u4e86\u3002
\u628a\u4ee3\u7801\u590d\u5236\u5230\u7a7a\u7a97\u4f53\u4e2d\u6309F5\u8fd0\u884c\u5373\u53ef\u3002
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 = ;\u6682\u505c;
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(;\u6e38\u620f\u7ed3\u675f\uff0c\u70b9\u201c\u662f\u201d\u91cd\u65b0\u5f00\u59cb\u6e38\u620f\uff0c\u70b9\u201c\u5426\u201d;, vbYesNo, ;\u8d2a\u5403\u86c7;) = 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
\u5e94\u8be5\u5c31\u662f\u8fd9\u4e2a\u4e86
'定义蛇的运动速度枚举值
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
以下在Form1，需要一个text控件，设定MultiLine为True
ClassNames(i)返回的是类名，所以你可以用instr函数查找你需要的ATO.....
另外这个示例是以窗口标题查找的，比如我这是打开“我的电脑”就可以运行下面示例
最后说明这个是网友Seneal的，我只是引用和解释
--------------------------------------
Private
Sub
Form_Load()
GetChildWindow
FindWindow(vbNullString,
Trim("我的电脑"))
考验VB编程能力喽
一楼
.
呵呵
我也觉着那啥
.
手把手
...至少值2000
我说的是
RMB..
www.codefans.net
很多游戏源码
有注释
绛旓細1銆侀鍏堝弻鍑绘闈㈠浘鏍囧惎鍔 visual basic 6.0銆2銆佺劧鍚庢柊寤哄伐绋嬶紝閫夋嫨鏍囧噯EXE銆3銆侀夋嫨瀹屽伐绋嬪悗锛岀偣鍑绘墦寮锛屽氨鍙互鏂板缓涓涓exe宸ョ▼浜嗐4銆佺劧鍚庡弻鍑 FORM1 绐椾綋锛屽湪寮瑰嚭鐨勪唬鐮佺獥浣撲腑澶嶅埗璇ヤ唬鐮佸埌 Form_Click() 浜嬩欢涓5銆佷唬鐮侊細If a * 100 + b * 10 + c = a ^ 3 + b ^ 3 + c ^...
绛旓細MsgBox " BS璐铔:涓涓瑙勫垯鏈绠鍗曠殑瓒ｅ懗娓告垙,鎮ㄥ皢鐢ㄩ敭鐩" & Chr(13) & _"涓婄殑4涓柟鍚戦敭鏉ユ帶鍒惰泧鐨勮繍鍔ㄦ柟鍚戙傚湪杩愬姩杩囩▼涓泧" & Chr(13) & _"涓嶈兘鍚庨,铔囩殑澶撮儴涔熶笉鑳芥帴瑙﹀埌杩愬姩鍖哄煙鐨勮竟绾夸互澶" & Chr(13) & _"鍜岃泧鑷繁鐨勮韩浣,鍚﹀垯灏辨父鎴忓け璐ャ傚湪鍚冩帀闅忔満鍑虹幇鐨" & Chr(13) & _"鏋滃瓙鍚,铔...
绛旓細绐椾綋鏀句袱涓狶abel鎺т欢锛涓涓Timer鎺т欢锛欴im 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 Label...
绛旓細Dim Label1Y As Integer '璁板綍绌虹櫧鎺т欢Label1宸︿笂瑙扽鐨勪綅缃 Dim flag(3) As Boolean '鑾峰彇绌虹櫧鎺т欢Label1鐨勪綅缃 Label1X = Label1.Left Label1Y = Label1.Top '瑕佺Щ鍔ㄧ殑鎺т欢浣嶄簬绌虹櫧鎺т欢Label1鐨勬宸︿晶 flag(0) = (Label2X = Label1X - Source.Width) And (Label2Y = Label1Y)'瑕佺Щ...
绛旓細杩欎釜浠ｇ爜涓嶈浠讳綍鎺т欢锛屼綘鍙渶瑕佹妸浠ヤ笅浠ｇ爜澶嶅埗鍒颁綘鐨勭獥浣撲唬鐮佷腑灏辫浜,浠ｇ爜寰堢畝鍗曪紝鐩镐俊浣犺兘鐪嬫噦锛佷粎浠呯敤浜涓涓缁撴瀯锛圫henTi锛変竴涓暟缁勶紙ZhuangTai(23, 23) As Long锛 涓涓彉閲忥紙GFangXiang锛変唬鐮佷腑鑷姩鐢熸垚浜員imer1锛孡abel1鎺т欢銆備互鍙婂嚑涓嚱鏁帮紙Randomize锛孋ircle锛孡ine锛孍rase...锛 鐩镐俊杩欎簺瀵逛簬...
绛旓細MsgBox " BS璐铔:涓涓瑙勫垯鏈绠鍗曠殑瓒ｅ懗娓告垙,鎮ㄥ皢鐢ㄩ敭鐩" & Chr(13) & _ "涓婄殑4涓柟鍚戦敭鏉ユ帶鍒惰泧鐨勮繍鍔ㄦ柟鍚戙傚湪杩愬姩杩囩▼涓泧" & Chr(13) & _ "涓嶈兘鍚庨,铔囩殑澶撮儴涔熶笉鑳芥帴瑙﹀埌杩愬姩鍖哄煙鐨勮竟绾夸互澶" & Chr(13) & _ "鍜岃泧鑷繁鐨勮韩浣,鍚﹀垯灏辨父鎴忓け璐ャ傚湪鍚冩帀闅忔満鍑虹幇鐨" & Chr(13) & _ "鏋滃瓙...
绛旓細鐢讳釜text1鍜宑ommand1 Private Sub Command1_Click()Dim a As Long a = Rnd * 100 MsgBox IIf(a = Val(Text1), "浣犵寽瀵逛簡锛屾暟瀛楁槸:" & a, "浣犵寽閿欎簡锛屾纭瓟妗堟槸:" & a)End Sub
绛旓細d)+"B"wscript.echo str loop if win=1 then wscript.echo "浣犵寽瀵逛簡銆" else wscript.echo "浣犳病鐚滃銆"/// 涓婇潰鏄垜鍐欒繃鐨涓涓皬娓告垙銆傛妸鏂滅嚎浠ヤ笂鐨勯儴鍒嗗鍒跺埌涓涓枃妗ｄ腑锛屽悗缂鍚嶆敼涓*.vbs锛岀洿鎺ュ弻鍑昏瘯璇曠湅鏁堟灉锛氾級鍙傝冭祫鏂欙細鎴戠殑缁忓巻 ...
绛旓細绠鏄撲笁鍥藉織 鍒涘缓9涓猚ommand锛1涓timer锛屾椂闂20000,9涓猼ext锛6涓猣arm銆傚竷缃鍥 浠ｇ爜濡備笅 Private Sub Form_Load()Text1.Text = "100" '鎴戞柟鍓╀綑澹叺 Text2.Text = "170" '瀵规柟鍓╀綑澹叺 Text3.Text = "180" '瀵规柟鍓╀綑澹叺 Text4.Text = "200" '瀵规柟鍓╀綑澹叺 Text5.Text = "500" '閲戦挶 ...
绛旓細鍦ㄤ唬鐮侀〉鐨勬渶鍓嶉潰鍔犲叆浠ヤ笅鐨2琛岋細Option Base 1 Dim x As Integer, y As Integer, z As Integer 鍙﹀锛屾墍鏈夌殑浠ヤ笅閮ㄥ垎瑕佷慨鏀癸細Text1.Text = ("鐢佃剳鑳滃埄 ") & x&(" 鐩")Text2.Text = ("浣犺儨鍒 ") & y&(" 鐩")鏀逛负锛歍ext1.Text = "鐢佃剳鑳滃埄 " & x & " 鐩"Text2.Text = "...
