打地鼠VB程序源代码.docx
《打地鼠VB程序源代码.docx》由会员分享，可在线阅读，更多相关《打地鼠VB程序源代码.docx（20页珍藏版）》请在冰豆网上搜索。
打地鼠VB程序源代码
打地鼠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=TrueEndSub
PrivateSubCommand2_Click（）
Timer1.Enabled=False'暂停
Label2.Caption="暂停中..."
Command1.Caption="继续"
Command1.Enabled=True
Command2.Enabled=FalseEndSub
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=oknum+1'打中次数+1
EndIf
EndSub
PrivateSubtc_Click（）UnloadMe'退出
EndSub
PrivateSubTimer1_Timer（）Text1.Text=oknum&"/"&allnum'打印得分
allnum=allnum+1'变化次数值+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=FalseOption2.Value=FalseOption3.Value=False
EndSub
PrivateSubOption1_Click（）
Randomize
SelectCaseInt（3*Rnd）
Case0:
a=MsgBox（"对方也出石头～继续～",1+64,"快乐游戏"）Case1:
a=MsgBox（"哈哈～你赢了～对方出的是剪刀～奖励你一个苹果～",1+64,"快乐游戏"）
Case2:
a=MsgBox（"你输了～对方出的是布哦～不好意思，苹果给对方了哈～",1+64,"快乐游戏"）
EndSelect
Option1.Value=False
EndSub
PrivateSubOption2_Click（）
Randomize
SelectCaseInt（3*Rnd）
Case0:
a=MsgBox（"你输了～对方出的是石头哦～不好意思，苹果给对方了哈～",1+64,"
快乐游戏"）
Case1:
a=MsgBox（"对方也出剪刀～继续～",1+64,"快乐游戏"）Case2:
a=MsgBox（"哈哈～你赢了～对方出的是布～奖励你一个苹果～",1+64,"快乐游戏"）
EndSelect
Option2.Value=False
EndSub
PrivateSubOption3_Click（）
Randomize
SelectCaseInt（3*Rnd）
Case0:
a=MsgBox（"哈哈～你赢了～对方出的是石头～奖励你一个苹果～",1+64,"快乐游戏"）
Case1:
a=MsgBox（"你输了～对方出的是剪刀哦～不好意思，苹果给对方了哈～",1+64,"
快乐游戏"）
Case2:
a=MsgBox（"对方也出布～继续～",1+64,"快乐游戏"）
EndSelect
Option3.Value=False
EndSub
*******SZ********
DimlenthAsInteger,qAsInteger
ConstPI=3.14159PrivateSubForm_Load（）lenth=Line1.Y2-Line1.Y1q=90
EndSub
PrivateSubTimer1_Timer（）
q=q-6
Line1.Y1=Line1.Y2-lenth*Sin（q*PI/180）
Line1.X1=Line1.X2+lenth*Cos（q*PI/180）
Label1.Caption="当前系统时间:
"&TimeLabel2.Caption="当前系统日期:
"&DateEndSub
*******TQ********
Dimx_stepAsIntegerDimy_stepAsIntegerDimgametimeAsIntegerDimgamescoreAsIntegerDimmove_xAsIntegerPrivateSubCommand1_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）/2FrmTQ.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-（90+move_x）
Line1.X2=Line1.X2-（90+move_x）
EndIf
Case39'如果按下右箭头,使板子向右移动
IfLine1.X2>=Picture1.Left+Picture1.WidthThen
Line1.X2=Picture1.Left+Picture1.Width
Else
Line1.X1=Line1.X1+（90+move_x）
Line1.X2=Line1.X2+（90+move_x）
EndIf
EndSelect
EndSub
PrivateSubTimer1_Timer（）
'右壁弹回
IfShape1.Left+Shape1.Width>=Picture1.Left+Picture1.WidthThen
Shape1.Left=Picture1.Left+Picture1.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.Top+Shape1.Height>=Line1.Y1And_
Shape1.Left>=Line1.X1And_
Shape1.Left<=Line1.X2Then
Shape1.Top=Line1.Y1-Shape1.Height
y_step=-y_step
gamescore=gamescore+10
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_x+15
EndIf
EndIf
EndIf
EndIf
'使小球移动
Shape1.MoveShape1.Left+x_step,Shape1.Top+y_step
'Shape1.Left=Shape1.Left+x_step'Shape1.Top=Shape1.Top+y_stepIfShape1.Top>=Line1.Y1ThenTimer1.Enabled=False
Timer2.Enabled=False
MsgBox"你输了!
!
!
!
",64
Callstart1_game
EndIf
EndSub
PrivateSubTimer2_Timer（）
gametime=gametime+1
Label4.Caption=Str（gametime）+"秒"
EndSub
******弹球模块********
PublicSubstart1_game（）gametime=0
gamescore=0
FrmTQ.Label2.Caption=0FrmTQ.Label4.Caption=0FrmTQ.Shape1.Top=600FrmTQ.Command1.Caption="开始"
FrmTQ.Line1.X1=1560FrmTQ.Line1.X2=2880move_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=FalseTimer2.Enabled=False'Shape2.Visible=FalseTimer3.Enabled=FalseFrmTCS.picture=LoadPicture（""）
p=0
p1=0
Runway=0
Runstep=Shape1（0）.Widthmaxlong=3'记录蛇身的长度
m_game=1'第一关
score=0'记录分数
'Line5.Visible=FalseLabelscore.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）.Leftsnake_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）.Left+Runstep
Callmove_snake'移动蛇
Callvore_game'判断游戏是否结束
Callgroup_snake'记录蛇的增长
Case3
Shape1（0）.Top=Shape1（0）.Top+Runstep
Callmove_snake'移动蛇
Callvore_game'判断游戏是否结束
Callgroup_snake'记录蛇的增长
EndSelect
EndSub
'生成食物
PrivateSubTimer2_Timer（）DimpointxAsIntegerDimpointyAsIntegerRandomize
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
EndSub
PrivateSubTimer3_Timer（）p1=p1+1
p=p+1
DimiAsInteger
IfpMod2=1Then
Fori=0TomaxlongStep1
Shape1（i）.Visible=FalseNexti
Else
Fori=0TomaxlongStep1Shape1（i）.Visible=TrueNexti
EndIf
Ifp1=6Then
Timer3.Enabled=False
'MsgBox"结束游戏!
!
"
EndIf
Screen.MousePointer=vbArrowEndSub
PrivateSubToolbar1_ButtonClick（ByValButtonAsMSComCtlLib.Button）
SelectCaseButton.KeyCase"start"
Callstart_Click
Case"stop"
Callstop_game
Case"gogo"
Callstart_game
Case"mm"
StaticpictureAsIntegerpicture=（picture+1）Mod4
Ifpicture=0Then
FrmTCS.picture=LoadPicture（""）
ExitSub
EndIf
Dims1AsString
s1="\bj"&picture&".jpg"
FrmTCS.picture=LoadPicture（App.Path+s1）
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=0TomaxlongStep1Ifi>=4Then'把加载的控件卸载
UnloadFrmTCS.Shape1（i）
EndIf
Ifi<=3Then
FrmTCS.Sh
升级会员 