VB制作小游戏源代码

跪求用vb6.0制作小游戏的源代码~

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
贪吃蛇游戏，不用放任何东西

我有 可惜就是我自己弄的 打地鼠加强版 然后当时我的技术也不高 所以代码很长！你要不？要的话加q，传你 q号：1092284452

猜数字
建一个文本文档，输入以下代码，后缀改为.frm用vb打开就可以了
以下是程序源码：
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 3 'Fixed Dialog
Caption = "猜数游戏"
ClientHeight = 3900
ClientLeft = 45
ClientTop = 435
ClientWidth = 4680
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3900
ScaleWidth = 4680
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command2
Caption = "重新开始"
Height = 615
Left = 2640
TabIndex = 2
Top = 2760
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "确定"
Height = 615
Left = 840
TabIndex = 1
Top = 2760
Width = 1095
End
Begin VB.TextBox Text1
Height = 375
Left = 1200
TabIndex = 0
Top = 2040
Width = 2055
End
Begin VB.Label Label9
Caption = "戏"
BeginProperty Font
Name = "宋体"
Size = 24
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000080FF&
Height = 615
Left = 3720
TabIndex = 11
Top = 240
Width = 615
End
Begin VB.Label Label8
Caption = "游"
BeginProperty Font
Name = "宋体"
Size = 24
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 615
Left = 3240
TabIndex = 10
Top = 240
Width = 615
End
Begin VB.Label Label7
Caption = "数"
BeginProperty Font
Name = "宋体"
Size = 24
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 495
Left = 2760
TabIndex = 9
Top = 240
Width = 615
End
Begin VB.Label Label6
Caption = "猜"
BeginProperty Font
Name = "宋体"
Size = 24
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF00FF&
Height = 495
Left = 2280
TabIndex = 8
Top = 240
Width = 735
End
Begin VB.Label Label5
Caption = "入"
BeginProperty Font
Name = "宋体"
Size = 24
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 615
Left = 1800
TabIndex = 7
Top = 240
Width = 855
End
Begin VB.Label Label4
Caption = "进"
BeginProperty Font
Name = "宋体"
Size = 24
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 735
Left = 1320
TabIndex = 6
Top = 240
Width = 735
End
Begin VB.Label Label3
Caption = "迎"
BeginProperty Font
Name = "宋体"
Size = 24
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF00&
Height = 735
Left = 840
TabIndex = 5
Top = 240
Width = 735
End
Begin VB.Label Label2
Caption = "欢"
BeginProperty Font
Name = "宋体"
Size = 24
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 615
Left = 360
TabIndex = 4
Top = 240
Width = 495
End
Begin VB.Label Label1
Caption = "我这儿有1~10的整数，你猜猜看他是多少......"
Height = 375
Left = 480
TabIndex = 3
Top = 1320
Width = 3855
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim x As Integer, y As Integer, z As Integer
Dim cishu As Integer
Private Sub Command1_Click()

If cishu = 3 Then MsgBox "已经猜3次了，这个数是" & x: Exit Sub
y = Val(Text1.Text)

If Text1.Text = "" Or Not IsNumeric(Text1.Text) Then
MsgBox "输入有误！请重新输入数字", 48
Text1.Text = ""
Text1.SetFocus
Exit Sub

End If

cishu = cishu + 1
Select Case x - y
Case Is < 0
z = MsgBox("你猜数大了，请重猜。注意：你只有三次机会", 48 + 1)
Text1.Text = ""
Text1.SetFocus
Case Is > 0
z = MsgBox("你猜数小了，请重猜。注意：你只有三次机会", 48 + 1)
Text1.Text = ""
Text1.SetFocus
Case Else
z = MsgBox("恭喜你猜中了！", 1)
End Select

End Sub

Private Sub Command2_Click()

cishu = 0
Randomize Timer
x = Int((Rnd * 10) + 1)
End Sub

Private Sub Form_Load()

cishu = 0
Randomize Timer
x = Int((Rnd * 10) + 1)
End Sub
代码结束
http://hi.baidu.com/卓7358/
欢迎来我空间

---

黄岩区18838662583： vb小游戏源代码 - ？
肥尚癫痫： Rem 窗体创建三个单选框按钮,Option1、Option2、Option3 Private Sub Form_Activate() Option1.Caption = ＂石头＂ Option2.Caption = ＂剪刀＂ Option3.Caption = ＂布＂ Option1.Value = False Option2.Value = False Option3.Value = False ...

黄岩区18838662583： ■用vb编一个简单的游戏(代码)(要详细) - ？
肥尚癫痫： '猜数字,这个简单了吧. Private Sub Form_Load()Randomizenum = Int(Rnd * 1000)str1 = ＂输入一个0到999间的整数＂Donum1 = Val(InputBox(str1))If num1 > num Thenstr1 = ＂大了＂ElseIf num1 < num Thenstr1 = ＂小了＂ElseMsgBox ＂恭喜您!答对了.＂Exit DoEnd IfLoop End Sub

黄岩区18838662583： 谁能给个vb小游戏的原代码？
肥尚癫痫：http://read.pudn.com/downloads6/sourcecode/games/21969/%D0%C2%BD%A8%CE%C4%BC%FE%BC%D01/%D4%B4%B4%FA%C2%EB/fLessons.frm__.htm 看下这个

黄岩区18838662583： 求VB小游戏代码 - ？
肥尚癫痫： 1个picture控件,一个label控件,一个time控件就完全足够了,呵呵 Public nn As Long Public n As Long Public x, y As LongPrivate Sub Form_Load()nn = 0n = 1''Picture1(i).Picture = ＂图片地址＂Picture1(i).Width = 300Picture1(i).Height = ...

黄岩区18838662583： 用VB制作个小游戏.急急急急急~!!!马上就要交了,随便什么都行,简单的小游戏,我会追加 的~~!! - ？
肥尚癫痫： Private Enum tpsSpeed QUICKLY = 0 SLOWLY = 1End Enum'定义蛇的运动方向枚举值Private Enum tpsDirec...

黄岩区18838662583： 诚征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 ...

黄岩区18838662583： 求一个VB精简版能做的简单小游戏的制作过程和代码 - ？
肥尚癫痫： 一个timer 一个label 在timer里写随机移动 label位置 让玩家去点击label 点中则加几分~ 你可自行调节移动的速度 来增加难度 left top这2个属性是位置 用rnd函数随机

黄岩区18838662583： 有VB语言编写一个小游戏程序？
肥尚癫痫： VB拼图游戏源码 http://lp.downcode.com/j_13/j_13178_VBpintu.rar 坦克大战游戏VB源代码 http://www.longtengwang.com/softcode/UploadFiles_8410/VB/游戏/“坦克大战”游戏源代码.rar

黄岩区18838662583： 求一个VB 小游戏代码 越简单越好谁帮忙写一个 网站上复制的不要 - ？
肥尚癫痫： Private Sub Form_Click() Dim p As POINTAPIDim 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 + ...

黄岩区18838662583： 高分急求一个简单的VB小游戏程序代码和控件,名字叫记忆牌,感谢各位了!可以用的话可以追加哦! - ？
肥尚癫痫： 工程我已发 Dim b(0 To 8) Dim m, k, n Private Sub Command1_Click() a = ＂012345678＂ For i = 0 To 8 Randomize temp = Int(Rnd * Len(a) + 1) Label1.Caption = 40 If i <= 1 Then b(Mid(a, temp, 1)) = ＂red＂ ElseIf i > 1 And i <= 3 Then b(Mid(a, ...