打地鼠VB程序代码

******DDS*******
Dim allnum As Integer, oknum As Integer '定义变化次数 打中次数
Private Sub a_Click()
Timer1.Interval = 1000 '新手
End Sub
Private Sub b_Click()
Timer1.Interval = 700 '达人
End Sub
Private Sub c_Click()
Timer1.Interval = 500 '老手
End Sub

Private Sub Command1_Click()
If Command1.Caption = "继续" Then
Timer1.Enabled = True
Label2.Caption = "运行中..."
Else
Timer1.Enabled = True '时间启动
allnum = 0 '变化次数初始为0
oknum = 0 '打中次数初始为0
Label2.Caption = "运行中..."

End If
Command1.Enabled = False
Command2.Enabled = True
End Sub
Private Sub Command2_Click()
Timer1.Enabled = False '暂停
Label2.Caption = "暂停中..."
Command1.Caption = "继续"
Command1.Enabled = True
Command2.Enabled = False
End Sub
Private Sub Command3_Click()
Unload Me '结束
End Sub



Private Sub Form_Load()
Timer1.Enabled = False '时间不启动
allnum = 0 '变化次数初始为0
oknum = 0 '打中次数初始为0
End Sub

Private Sub Picture1_Click(Index As Integer)
If Picture1(Index).Visible = True Then
Picture1(Index).picture = Src.Picture1.picture '击晕图显示
oknum = oknum + 1 '打中次数+1

End If
End Sub

Private Sub tc_Click()
Unload Me '退出
End Sub

Private Sub Timer1_Timer()
Text1.Text = oknum & "/" & allnum '打印得分
allnum = allnum + 1 '变化次数值+1
For i = 0 To 23
Picture1(i).Visible = False '地鼠消失
Next
Randomize
Picture1(Int(Rnd() * 23)).Visible = True '随机函数控制地鼠图片显示
End Sub

Private Sub gy_Click()
MsgBox "打地鼠" + Chr(13) + Chr(13) + "Boy小作品" + Chr(13) + _
"QQ：591028872", , "作者寄语" '作者寄语
End Sub


********SJB********



Private Sub Form_Activate()
Option1.Caption = "石头"
Option2.Caption = "剪刀"
Option3.Caption = "布"
Option1.Value = False
Option2.Value = False
Option3.Value = False


End Sub

Private Sub Option1_Click()
Randomize
Select Case Int(3 * Rnd)
Case 0: a = MsgBox("对方也出石头！继续！", 1 + 64, "快乐游戏")
Case 1: a = MsgBox("哈哈！你赢了！对方出的是剪刀！奖励你一个苹果！", 1 + 64, "快乐游戏")
Case 2: a = MsgBox("你输了！对方出的是布哦！不好意思，苹果给对方了哈！", 1 + 64, "快乐游戏")
End Select
Option1.Value = False

End Sub

Private Sub Option2_Click()
Randomize
Select Case Int(3 * Rnd)
Case 0: a = MsgBox("你输了！对方出的是石头哦！不好意思，苹果给对方了哈！", 1 + 64, "快乐游戏")
Case 1: a = MsgBox("对方也出剪刀！继续！", 1 + 64, "快乐游戏")
Case 2: a = MsgBox("哈哈！你赢了！对方出的是布！奖励你一个苹果！", 1 + 64, "快乐游戏")
End Select
Option2.Value = False

End Sub

Private Sub Option3_Click()
Randomize
Select Case Int(3 * Rnd)
Case 0: a = MsgBox("哈哈

！你赢了！对方出的是石头！奖励你一个苹果！", 1 + 64, "快乐游戏")
Case 1: a = MsgBox("你输了！对方出的是剪刀哦！不好意思，苹果给对方了哈！", 1 + 64, "快乐游戏")
Case 2: a = MsgBox("对方也出布！继续！", 1 + 64, "快乐游戏")
End Select
Option3.Value = False

End Sub


*******SZ********


Dim lenth As Integer, q As Integer
Const PI = 3.14159
Private Sub Form_Load()
lenth = Line1.Y2 - Line1.Y1
q = 90
End Sub


Private Sub Timer1_Timer()
q = q - 6
Line1.Y1 = Line1.Y2 - lenth * Sin(q * PI / 180)
Line1.X1 = Line1.X2 + lenth * Cos(q * PI / 180)
Label1.Caption = "当前系统时间：" & Time
Label2.Caption = "当前系统日期：" & Date
End Sub


*******TQ********

Dim x_step As Integer
Dim y_step As Integer
Dim gametime As Integer
Dim gamescore As Integer
Dim move_x As Integer
Private Sub Command1_Click()
Picture1.SetFocus
If Command1.Caption = "开始" Then
Timer1.Enabled = True
Timer2.Enabled = True
Command1.Caption = "暂停"
ElseIf Command1.Caption = "暂停" Then
Timer1.Enabled = False
Timer2.Enabled = False
Command1.Caption = "继续"
ElseIf Command1.Caption = "继续" Then
Command1.Caption = "暂停"
Timer1.Enabled = True
Timer2.Enabled = True
End If
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Load()
x_step = 250
y_step = 250
move_x = 0
Command1.Caption = "开始"
Timer1.Enabled = False
Timer2.Enabled = False
gametime = 0
gamescore = 0
FrmTQ.Left = (Screen.Width - FrmTQ.Width) / 2
FrmTQ.Top = (Screen.Height - FrmTQ.Height) / 2 - 600

End Sub

Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case 37 '如果按下左箭头,使板子向左移动
If Line1.X1 <= Picture1.Left Then
Line1.X1 = Picture1.Left
Else
Line1.X1 = Line1.X1 - (90 + move_x)
Line1.X2 = Line1.X2 - (90 + move_x)

End If
Case 39 '如果按下右箭头,使板子向右移动
If Line1.X2 >= Picture1.Left + Picture1.Width Then
Line1.X2 = Picture1.Left + Picture1.Width
Else
Line1.X1 = Line1.X1 + (90 + move_x)
Line1.X2 = Line1.X2 + (90 + move_x)
End If
End Select
End Sub

Private Sub Timer1_Timer()
'右壁弹回
If Shape1.Left + Shape1.Width >= Picture1.Left + Picture1.Width Then
Shape1.Left = Picture1.Left + Picture1.Width - Shape1.Width
x_step = -x_step

End If
'左壁弹回
If Shape1.Left <= 0 Then
Shape1.Left = 0
x_step = -x_step
End If
'上壁弹回
If Shape1.Top <= 0 Then
Shape1.Top = 0
y_step = -y_step

End If
'弹板弹回
If Shape1.Top + Shape1.Height >= Line1.Y1 And _
Shape1.Left >= Line1.X1 And _
Shape1.Left <= Line1.X2 Then
Shape1.Top = Line1.Y1 - Shape1.Height
y_step = -y_step
gamescore = gamescore + 10
Label2.Caption = gamescore
If gamescore Mod 50 = 0 Then
If Line1.X2 - Line1.X1 > 300 Then
Line1.X2 = Line1.X2 - 100
If Timer1

.Interval > 50 Then
Timer1.Interval = Timer1.Interval - 30
move_x = move_x + 15
End If
End If
End If
End If


'使小球移动
Shape1.Move Shape1.Left + x_step, Shape1.Top + y_step
'Shape1.Left = Shape1.Left + x_step
'Shape1.Top = Shape1.Top + y_step
If Shape1.Top >= Line1.Y1 Then
Timer1.Enabled = False
Timer2.Enabled = False
MsgBox "你输了!!!!", 64
Call start1_game

End If
End Sub

Private Sub Timer2_Timer()
gametime = gametime + 1
Label4.Caption = Str(gametime) + "秒"

End Sub


******弹球模块********



Public Sub start1_game()
gametime = 0
gamescore = 0
bel2.Caption = 0
bel4.Caption = 0
FrmTQ.Shape1.Top = 600
mand1.Caption = "开始"
FrmTQ.Line1.X1 = 1560
FrmTQ.Line1.X2 = 2880
move_x = 0
End Sub





********TCS*******




Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'Runawy =0 左移
' =1 上移
' =2 右
' =3 下

Select Case KeyCode
Case 37 '点击左键
If Runway <> 2 Then '蛇没有向右移动
Runway = 0 '左
End If
Case 38 '点击上键
If Runway <> 3 Then
Runway = 1
End If
Case 39 '点击右键
If Runway <> 0 Then
Runway = 2
End If
Case 40 '点击下键
If Runway <> 1 Then
Runway = 3
End If
Case 83 '点击s键为暂停
'MsgBox "s键"
Call stop_game
Case 84 '再次开始游戏
Call start_game

End Select


End Sub

Private Sub Form_Load()
Timer1.Enabled = False
Timer2.Enabled = False
'Shape2.Visible = False
Timer3.Enabled = False
FrmTCS.picture = LoadPicture("")

p = 0
p1 = 0
Runway = 0
Runstep = Shape1(0).Width
maxlong = 3 '记录蛇身的长度
m_game = 1 '第一关
score = 0 '记录分数
'Line5.Visible = False
Labelscore.ForeColor = RGB(0, 255, 0)
time1 = Timer1.Interval

Dim i As Integer
For i = 0 To 3 Step 1 '游戏开始前 记录蛇的位置
snake_init(i).x = Shape1(i).Left
snake_init(i).y = Shape1(i).Top
'
'snake_stop(i).x = Shape1(i).Left
'snake_stop(i).y = Shape1(i).Top

Next i

End Sub



'开始游戏
Private Sub start_Click()
Timer1.Enabled = True
Timer2.Enabled = True
Call init_game
End Sub



'
Private Sub Timer1_Timer()
'在蛇移动前 记录蛇头的位置

snake_point.x = Shape1(0).Left
snake_point.y = Shape1(0).Top
'snake_stopX(0) = Shape1(0).Left
'snake_stopY(0) = Shape1(0).Top

Select Case Runway
Case 0 '左移动
Shape1(0).Left = Shape1(0).Left - Runstep
Call move_snake '移动蛇
Call vore_game '判断游戏是否结束
Call group_snake '记录蛇的增长
Case 1 '上移动
Shape1(0).Top = Shape1(0).Top - Runstep
Call move_snake '移动蛇
Call vore_game '判断游戏是否结束
Call group_snake '记录蛇的增长
Case 2 ' 右移动
Shape1(0).Left = Shape1(0).Left + Runstep
Call move_snake '移动蛇
Call vore_game '

判断游戏是否结束
Call group_snake '记录蛇的增长
Case 3
Shape1(0).Top = Shape1(0).Top + Runstep
Call move_snake '移动蛇
Call vore_game '判断游戏是否结束
Call group_snake '记录蛇的增长

End Select
End Sub

'生成食物
Private Sub Timer2_Timer()
Dim pointx As Integer
Dim pointy As Integer
Randomize
pointx = Rnd * (Line1.X2 - Line1.X1 + 5) + Line1.X1
pointy = Rnd * (Line2.Y2 - Line2.Y1 + 5) + Line2.Y1
Shape2.Left = pointx
Shape2.Top = pointy
Shape2.FillColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)

Shape2.Visible = True

Timer2.Interval = 5000

End Sub




Private Sub Timer3_Timer()
p1 = p1 + 1
p = p + 1
Dim i As Integer
If p Mod 2 = 1 Then


For i = 0 To maxlong Step 1
Shape1(i).Visible = False
Next i
Else


For i = 0 To maxlong Step 1
Shape1(i).Visible = True
Next i

End If
If p1 = 6 Then
Timer3.Enabled = False

'MsgBox "结束游戏!!"
End If
Screen.MousePointer = vbArrow
End Sub





Private Sub Toolbar1_ButtonClick(ByVal Button As MSComCtlLib.Button)
Select Case Button.Key
Case "start"
Call start_Click
Case "stop"
Call stop_game
Case "gogo"
Call start_game

Case "mm"
Static picture As Integer
picture = (picture + 1) Mod 4
If picture = 0 Then
FrmTCS.picture = LoadPicture("")
Exit Sub
End If
Dim s1 As String
s1 = "\bj" & picture & ".jpg"

FrmTCS.picture = LoadPicture(App.Path + s1)
Case "overgame"
Call end_game
Case "kuai"
Call nd2_game
End Select
End Sub

*******贪吃蛇模块********



Public Runway As Integer '标明蛇移动的方向 初始化为 0(左)
Public p As Integer
Public p1 As Integer
Public Runstep As Integer '蛇头的宽度
Public maxlong As Integer '蛇的长度 初始化为3
Public Type str_snake_point '记录蛇的位置
x As Integer
y As Integer

End Type
Public snake_init(0 To 3) As str_snake_point '初始化记录蛇的位置
Public snake_point As str_snake_point '记录蛇移动时的坐标
'该动态数组保存蛇暂停时的位置
'Public snake_stopX() As Integer
'Public snake_stopY() As Integer
'Public snake_stop() As str_snake_point '该动态数组保存蛇暂停时的位置
Public m_game As Integer '标明游戏关数
Public score As Integer '分数的记录
Public time1 As Integer

Public Sub init_game() '初始化游戏
'Timer1.Enabled = True
'Timer2.Enabled = True
'ReDim snake_stopX(0 To maxlong)
' ReDim snake_stopY(0 To maxlong)
' MsgBox Str(LBound(snake_stopX))
' MsgBox Str(UBound(snake_stopX))

Dim i As Integer
'ReDim sanke_stop(0 To maxlong)
For i = 0 To maxlong Step 1
If i >= 4 Then '把加载的控件卸载
Unload FrmTCS.Shape1(i)
End If
If i <= 3 Then
FrmTCS.Shape1(i).Left = snake_init(i).x
FrmTCS.Shape1(i).Top = snake_init(i).y


'snake_stop(i).x = Form1.Shape1(i).Left
'snake_stop(i).y = Form1.Shape1(i).Top
End If
Next i
maxlong = 3
p = 0
p1 = 0
Runway = 0
'm_game = 1 '初始化为第

一关
Screen.MousePointer = 99
'MsgBox App.Path + "\ANIMAL"
Screen.MouseIcon = LoadPicture(App.Path + "\ANIMAL.ico")
End Sub
'蛇的移动
Public Sub move_snake()
Dim tempx As Integer
Dim tempy As Integer '两个变量记录 要移动接点的坐标
Dim i As Integer
For i = 1 To maxlong Step 1
tempx = FrmTCS.Shape1(i).Left
tempy = FrmTCS.Shape1(i).Top
FrmTCS.Shape1(i).Left = snake_point.x
FrmTCS.Shape1(i).Top = snake_point.y
snake_point.x = tempx
snake_point.y = tempy
'snake_stopX(i) = tempx
'snake_stopY(i) = tempy
Next i
End Sub
'判断游戏是否结束
Public Sub vore_game()
Dim i As Integer
'游戏当蛇碰到边界 结束
'蛇碰到自己 结束
If FrmTCS.Shape1(0).Left <= FrmTCS.Line1.X1 + 50 Then
'碰到左边界
FrmTCS.Timer1.Enabled = False
FrmTCS.Timer2.Enabled = False
FrmTCS.Timer3.Enabled = True

End If
If FrmTCS.Shape1(0).Left + FrmTCS.Shape1(i).Width > FrmTCS.Line1.X2 Then
'碰到右边界
FrmTCS.Timer1.Enabled = False
FrmTCS.Timer2.Enabled = False
FrmTCS.Timer3.Enabled = True

End If
If FrmTCS.Shape1(0).Top < FrmTCS.Line2.Y1 Then
'碰到上边界
FrmTCS.Timer1.Enabled = False
FrmTCS.Timer2.Enabled = False
FrmTCS.Timer3.Enabled = True

End If
If FrmTCS.Shape1(0).Top + FrmTCS.Shape1(0).Height > FrmTCS.Line2.Y2 Then
'碰到下边界
FrmTCS.Timer1.Enabled = False
FrmTCS.Timer2.Enabled = False
FrmTCS.Timer3.Enabled = True

End If
For i = 1 To maxlong Step 1
If FrmTCS.Shape1(0).Left = FrmTCS.Shape1(i).Left And _
FrmTCS.Shape1(0).Top = FrmTCS.Shape1(i).Top Then
FrmTCS.Timer1.Enabled = False
FrmTCS.Timer2.Enabled = False
FrmTCS.Timer3.Enabled = True
End If
Next i
' If game = 1 Then
'If Form1.Shape1(0).Left < Form1.Line5.X1 And _
' Form1.Shape1(0).Left + Form1.Shape1(0).Width > Form1.Line5.X1 And _
' Form1.Shape1(0).Top > Form1.Line5.Y1 And _
' Form1.Shape1(0).Top < Form1.Line5.Y2 Then
' Form1.Timer1.Enabled = False
' Form1.Timer2.Enabled = False
' Form1.Timer3.Enabled = True
' End If
'End If
End Sub

Public Sub group_snake()
'Set frm = Form1
If FrmTCS.Shape2.Left > FrmTCS.Shape1(i).Left And _
FrmTCS.Shape2.Left < FrmTCS.Shape1(i).Left + FrmTCS.Shape1(0).Width And _
FrmTCS.Shape2.Top > FrmTCS.Shape1(i).Top And _
FrmTCS.Shape2.Top < FrmTCS.Shape1(i).Top + FrmTCS.Shape1(i).Height Then

'向左吃食物(满足上面条件 既吃到食物)
FrmTCS.Shape2.Visible = False '
maxlong = maxlong + 1 '蛇身加1
Load FrmTCS.Shape1(maxlong) '加载一个数组控件
'初始化位置
FrmTCS.Shape1(maxlong).Left = FrmTCS.Shape1(maxlong - 1).Left + FrmTCS.Shape1(maxlong - 1).Width
FrmTCS.Shape1(maxlong).Top = FrmTCS.Shape1(maxlong - 1).Top + FrmTCS.Shape1(maxlong - 1).Height
Randomize
FrmTCS.Shape1(maxlong).FillColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
FrmTCS.Shape1(maxlong).Shape = 0
FrmTCS.Shape1(maxlong).Visible = True
score = score + 10
belscore.Caption = score

End If
If score = 200 Then

m_game = m_game + 1
FrmTCS.Timer1.Enabled = False
FrmTCS.Timer2.Enabled = False
MsgBox "恭喜你闯过第" & m_game - 1 & "关" & "按回车键 开始下一关!!", 64

score = 0
Call init_game
time1 = FrmTCS.Timer1.Interval - m_game * 15
FrmTCS.Timer2.Interval = FrmTCS.Timer2.Interval - m_game * 400
If time1 <= 0 Then
MsgBox "高手 你闯过了所有的关数 "
time1 = 200
FrmTCS.Timer1.Enabled = False
FrmTCS.Timer2.Enabled = False
End If
FrmTCS.Timer1.Interval = time1


belscore.Caption = score
FrmTCS.Timer1.Enabled = True
FrmTCS.Timer2.Enabled = True
End If

End Sub
'停止游戏
Public Sub stop_game()
FrmTCS.Timer1.Enabled = False
FrmTCS.Timer2.Enabled = False

End Sub

'解除暂停
Public Sub start_game()
FrmTCS.Timer1.Enabled = True
FrmTCS.Timer2.Enabled = True
End Sub
'退出游戏
Public Sub end_game()
FrmTCS.Hide
End Sub

Public Sub nd2_game()
Timer2.enable = True
End Sub