打地鼠VB程序代码.docx
- 文档编号:1926682
- 上传时间:2023-05-02
- 格式:DOCX
- 页数:23
- 大小:18.38KB
打地鼠VB程序代码.docx
《打地鼠VB程序代码.docx》由会员分享,可在线阅读,更多相关《打地鼠VB程序代码.docx(23页珍藏版)》请在冰点文库上搜索。
打地鼠VB程序代码
******DDS*******
DimallnumAsInteger,oknumAsInteger'定义变化次数打中次数
PrivateSuba_Click()
Timer1.Interval=1000'新手
EndSub
PrivateSubb_Click()
Timer1.Interval=700'达人
EndSub
PrivateSubc_Click()
Timer1.Interval=500'老手
EndSub
PrivateSubCommand1_Click()
IfCommand1.Caption="继续"Then
Timer1.Enabled=True
Label2.Caption="运行中..."
Else
Timer1.Enabled=True'时间启动
allnum=0'变化次数初始为0
oknum=0'打中次数初始为0
Label2.Caption="运行中..."
EndIf
Command1.Enabled=False
Command2.Enabled=True
EndSub
PrivateSubCommand2_Click()
Timer1.Enabled=False'暂停
Label2.Caption="暂停中..."
Command1.Caption="继续"
Command1.Enabled=True
Command2.Enabled=False
EndSub
PrivateSubCommand3_Click()
UnloadMe'结束
EndSub
PrivateSubForm_Load()
Timer1.Enabled=False'时间不启动
allnum=0'变化次数初始为0
oknum=0'打中次数初始为0
EndSub
PrivateSubPicture1_Click(IndexAsInteger)
IfPicture1(Index).Visible=TrueThen
Picture1(Index).picture=Src.Picture1.picture'击晕图显示
oknum=oknum1'打中次数1
EndIf
EndSub
PrivateSubtc_Click()
UnloadMe'退出
EndSub
PrivateSubTimer1_Timer()
Text1.Text=oknum&"/"&allnum'打印得分
allnum=allnum1'变化次数值1
Fori=0To23
Picture1(i).Visible=False'地鼠消失
Next
Randomize
Picture1(Int(Rnd()*23)).Visible=True'随机函数控制地鼠图片显示
EndSub
PrivateSubgy_Click()
MsgBox"打地鼠"Chr(13)Chr(13)"Boy小作品"Chr(13)_
"QQ:
591028872",,"作者寄语"'作者寄语
EndSub
********SJB********
PrivateSubForm_Activate()
Option1.Caption="石头"
Option2.Caption="剪刀"
Option3.Caption="布"
Option1.Value=False
Option2.Value=False
Option3.Value=False
EndSub
PrivateSubOption1_Click()
Randomize
SelectCaseInt(3*Rnd)
Case0:
a=MsgBox("对方也出石头!
继续!
",164,"快乐游戏")
Case1:
a=MsgBox("哈哈!
你赢了!
对方出的是剪刀!
奖励你一个苹果!
",164,"快乐游戏")
Case2:
a=MsgBox("你输了!
对方出的是布哦!
不好意思,苹果给对方了哈!
",164,"快乐游戏")
EndSelect
Option1.Value=False
EndSub
PrivateSubOption2_Click()
Randomize
SelectCaseInt(3*Rnd)
Case0:
a=MsgBox("你输了!
对方出的是石头哦!
不好意思,苹果给对方了哈!
",164,"快乐游戏")
Case1:
a=MsgBox("对方也出剪刀!
继续!
",164,"快乐游戏")
Case2:
a=MsgBox("哈哈!
你赢了!
对方出的是布!
奖励你一个苹果!
",164,"快乐游戏")
EndSelect
Option2.Value=False
EndSub
PrivateSubOption3_Click()
Randomize
SelectCaseInt(3*Rnd)
Case0:
a=MsgBox("哈哈!
你赢了!
对方出的是石头!
奖励你一个苹果!
",164,"快乐游戏")
Case1:
a=MsgBox("你输了!
对方出的是剪刀哦!
不好意思,苹果给对方了哈!
",164,"快乐游戏")
Case2:
a=MsgBox("对方也出布!
继续!
",164,"快乐游戏")
EndSelect
Option3.Value=False
EndSub
*******SZ********
DimlenthAsInteger,qAsInteger
ConstPI=3.14159
PrivateSubForm_Load()
lenth=Line1.Y2-Line1.Y1
q=90
EndSub
PrivateSubTimer1_Timer()
q=q-6
Line1.Y1=Line1.Y2-lenth*Sin(q*PI/180)
Line1.X1=Line1.X2lenth*Cos(q*PI/180)
Label1.Caption="当前系统时间:
"&Time
Label2.Caption="当前系统日期:
"&Date
EndSub
*******TQ********
Dimx_stepAsInteger
Dimy_stepAsInteger
DimgametimeAsInteger
DimgamescoreAsInteger
Dimmove_xAsInteger
PrivateSubCommand1_Click()
Picture1.SetFocus
IfCommand1.Caption="开始"Then
Timer1.Enabled=True
Timer2.Enabled=True
Command1.Caption="暂停"
ElseIfCommand1.Caption="暂停"Then
Timer1.Enabled=False
Timer2.Enabled=False
Command1.Caption="继续"
ElseIfCommand1.Caption="继续"Then
Command1.Caption="暂停"
Timer1.Enabled=True
Timer2.Enabled=True
EndIf
EndSub
PrivateSubCommand2_Click()
UnloadMe
EndSub
PrivateSubForm_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
EndSub
PrivateSubPicture1_KeyDown(KeyCodeAsInteger,ShiftAsInteger)
SelectCaseKeyCode
Case37'如果按下左箭头,使板子向左移动
IfLine1.X1<=Picture1.LeftThen
Line1.X1=Picture1.Left
Else
Line1.X1=Line1.X1-(90move_x)
Line1.X2=Line1.X2-(90move_x)
EndIf
Case39'如果按下右箭头,使板子向右移动
IfLine1.X2>=Picture1.LeftPicture1.WidthThen
Line1.X2=Picture1.LeftPicture1.Width
Else
Line1.X1=Line1.X1(90move_x)
Line1.X2=Line1.X2(90move_x)
EndIf
EndSelect
EndSub
PrivateSubTimer1_Timer()
'右壁弹回
IfShape1.LeftShape1.Width>=Picture1.LeftPicture1.WidthThen
Shape1.Left=Picture1.LeftPicture1.Width-Shape1.Width
x_step=-x_step
EndIf
'左壁弹回
IfShape1.Left<=0Then
Shape1.Left=0
x_step=-x_step
EndIf
'上壁弹回
IfShape1.Top<=0Then
Shape1.Top=0
y_step=-y_step
EndIf
'弹板弹回
IfShape1.TopShape1.Height>=Line1.Y1And_
Shape1.Left>=Line1.X1And_
Shape1.Left<=Line1.X2Then
Shape1.Top=Line1.Y1-Shape1.Height
y_step=-y_step
gamescore=gamescore10
Label2.Caption=gamescore
IfgamescoreMod50=0Then
IfLine1.X2-Line1.X1>300Then
Line1.X2=Line1.X2-100
IfTimer1.Interval>50Then
Timer1.Interval=Timer1.Interval-30
move_x=move_x15
EndIf
EndIf
EndIf
EndIf
'使小球移动
Shape1.MoveShape1.Leftx_step,Shape1.Topy_step
'Shape1.Left=Shape1.Leftx_step
'Shape1.Top=Shape1.Topy_step
IfShape1.Top>=Line1.Y1Then
Timer1.Enabled=False
Timer2.Enabled=False
MsgBox"你输了!
!
!
!
",64
Callstart1_game
EndIf
EndSub
PrivateSubTimer2_Timer()
gametime=gametime1
Label4.Caption=Str(gametime)"秒"
EndSub
******弹球模块********
PublicSubstart1_game()
gametime=0
gamescore=0
FrmTQ.Label2.Caption=0
FrmTQ.Label4.Caption=0
FrmTQ.Shape1.Top=600
FrmTQ.Command1.Caption="开始"
FrmTQ.Line1.X1=1560
FrmTQ.Line1.X2=2880
move_x=0
EndSub
********TCS*******
PrivateSubForm_KeyDown(KeyCodeAsInteger,ShiftAsInteger)
'Runawy=0左移
'=1上移
'=2右
'=3下
SelectCaseKeyCode
Case37'点击左键
IfRunway<>2Then'蛇没有向右移动
Runway=0'左
EndIf
Case38'点击上键
IfRunway<>3Then
Runway=1
EndIf
Case39'点击右键
IfRunway<>0Then
Runway=2
EndIf
Case40'点击下键
IfRunway<>1Then
Runway=3
EndIf
Case83'点击s键为暂停
'MsgBox"s键"
Callstop_game
Case84'再次开始游戏
Callstart_game
EndSelect
EndSub
PrivateSubForm_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
DimiAsInteger
Fori=0To3Step1'游戏开始前记录蛇的位置
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
Nexti
EndSub
'开始游戏
PrivateSubstart_Click()
Timer1.Enabled=True
Timer2.Enabled=True
Callinit_game
EndSub
'
PrivateSubTimer1_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
SelectCaseRunway
Case0'左移动
Shape1(0).Left=Shape1(0).Left-Runstep
Callmove_snake'移动蛇
Callvore_game'判断游戏是否结束
Callgroup_snake'记录蛇的增长
Case1'上移动
Shape1(0).Top=Shape1(0).Top-Runstep
Callmove_snake'移动蛇
Callvore_game'判断游戏是否结束
Callgroup_snake'记录蛇的增长
Case2'右移动
Shape1(0).Left=Shape1(0).LeftRunstep
Callmove_snake'移动蛇
Callvore_game'判断游戏是否结束
Callgroup_snake'记录蛇的增长
Case3
Shape1(0).Top=Shape1(0).TopRunstep
Callmove_snake'移动蛇
Callvore_game'判断游戏是否结束
Callgroup_snake'记录蛇的增长
EndSelect
EndSub
'生成食物
PrivateSubTimer2_Timer()
DimpointxAsInteger
DimpointyAsInteger
Randomize
pointx=Rnd*(Line1.X2-Line1.X15)Line1.X1
pointy=Rnd*(Line2.Y2-Line2.Y15)Line2.Y1
Shape2.Left=pointx
Shape2.Top=pointy
Shape2.FillColor=RGB(Rnd*255,Rnd*255,Rnd*255)
Shape2.Visible=True
Timer2.Interval=5000
EndSub
PrivateSubTimer3_Timer()
p1=p11
p=p1
DimiAsInteger
IfpMod2=1Then
Fori=0TomaxlongStep1
Shape1(i).Visible=False
Nexti
Else
Fori=0TomaxlongStep1
Shape1(i).Visible=True
Nexti
EndIf
Ifp1=6Then
Timer3.Enabled=False
'MsgBox"结束游戏!
!
"
EndIf
Screen.MousePointer=vbArrow
EndSub
PrivateSubToolbar1_ButtonClick(ByValButtonAsMSComCtlLib.Button)
SelectCaseButton.Key
Case"start"
Callstart_Click
Case"stop"
Callstop_game
Case"gogo"
Callstart_game
Case"mm"
StaticpictureAsInteger
picture=(picture1)Mod4
Ifpicture=0Then
FrmTCS.picture=LoadPicture("")
ExitSub
EndIf
Dims1AsString
s1="\bj"&picture&".jpg"
FrmTCS.picture=LoadPicture(App.Paths1)
Case"overgame"
Callend_game
Case"kuai"
Callnd2_game
EndSelect
EndSub
*******贪吃蛇模块********
PublicRunwayAsInteger'标明蛇移动的方向初始化为0(左)
PublicpAsInteger
Publicp1AsInteger
PublicRunstepAsInteger'蛇头的宽度
PublicmaxlongAsInteger'蛇的长度初始化为3
PublicTypestr_snake_point'记录蛇的位置
xAsInteger
yAsInteger
EndType
Publicsnake_init(0To3)Asstr_snake_point'初始化记录蛇的位置
Publicsnake_pointAsstr_snake_point'记录蛇移动时的坐标
'该动态数组保存蛇暂停时的位置
'Publicsnake_stopX()AsInteger
'Publicsnake_stopY()AsInteger
'Publicsnake_stop()Asstr_snake_point'该动态数组保存蛇暂停时的位置
Publicm_gameAsInteger'标明游戏关数
PublicscoreAsInteger'分数的记录
Publictime1AsInteger
PublicSubinit_game()'初始化游戏
'Timer1.Enabled=True
'Timer2.Enabled=True
'ReDimsnake_stopX(0Tomaxlong)
'ReDimsnake_stopY(0Tomaxlong)
'MsgBoxStr(LBound(snake_stopX))
'MsgBoxStr(UBound(snake_stopX))
DimiAsInteger
'ReDimsanke_stop(0Tomaxlong)
Fori=0TomaxlongStep1
Ifi>=4Then'把加载的控件卸载
UnloadFrmTCS.Shape1(i)
EndIf
Ifi<=3Then
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.Shape
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 地鼠 VB 程序代码