vb小游戏代码.docx
《vb小游戏代码.docx》由会员分享，可在线阅读，更多相关《vb小游戏代码.docx（13页珍藏版）》请在冰豆网上搜索。
vb小游戏代码
数字排序小游戏
OptionExplicit
DimLabel2XAsInteger'记录标签控件数组中要移动的标签控件左上角X的位置
DimLabel2YAsInteger'记录标签控件数组中要移动的标签控件左上角Y的位置'让标签数组中的每个标签控件上显示的数字是随机的，无重复的
PrivateSublnit（）
Randomize
Dima（7）AsInteger
DimiAsInteger,kAsInteger
Label1.Caption=""
Fori=0To7a（i）=i
Next
Fori=0To7
k=Int（Rnd*8）
DoWhilea（k）=-1'a（k）=-1表示该数组元素对应的数字已经被使用过了
k=Int（Rnd*8）'重新生成k的值，直到a（k）的值不等于-1
Loop
Label2（i）.Caption=Trim（Str（a（k）））
a（k）=-1'a（k）的值已经使用了，不能再用，重新赋值为-1与其他的元素值相区别
Nexti
EndSub
PrivateSubCommand1_Click（）
DimxAsInteger,yAsInteger
DimzAsInteger
Init
Picture1.Enabled=True
'让空白标签Label1出现的位置随机
Randomize
'记录下空白标签Label1的位置
x=Label1.Left
y=Label1.Top
z=Int（Rnd*8）
'将空白标签Label1和标签控件数组任一控件交换位置
Label1.MoveLabel2（z）.Left,Label2（z）.Top
Label2（z）.Movex,y
Command1.Enabled=False
EndSub
PrivateSubCommand2_Click（）
End
EndSub
PrivateSubForm_Load（）DimiAsIntegerPicture1.Enabled=False
'在标签中显示游戏说明信息
Label3.Caption="如左图所示，将数字按0-7顺"&vbCrLf&vbCrLf&"序依次排列，即取得胜利
'在标签中显示排列规则后的数字顺序
Label1.Caption=0
Fori=0To6
Label2（i）.Caption=i+1
Next
EndSub
PrivateSubLabel1_DragDrop（SourceAsControl,xAsSingle,yAsSingle）
DimLabel1XAsInteger'记录空白控件Label1左上角X的位置
DimLabel1YAsInteger'记录空白控件Label1左上角Y的位置
Dimflag（3）AsBoolean
'获取空白控件Label1的位置
Label1X=Label1.Left
Label1Y=Label1.Top
'要移动的控件位于空白控件Label1的正左侧flag（0）=（Label2X=Label1X-Source.Width）And（Label2Y=Label1Y）
'要移动的控件位于空白控件Label1的正右侧flag
（1）=（Label2X=Label1X+Source.Width）And（Label2Y=Label1Y）
'要移动的控件位于空白控件Label1的正上方flag
（2）=（Label2X=Label1X）And（Label2Y=Label1Y-Source.Height）
'要移动的控件位于空白控件Label1的正下方flag（3）=（Label2X=Label1X）And（Label2Y=Label1Y+Source.Height）
Ifflag（0）Orflag
（1）Orflag
（2）Orflag（3）Then
Label1.MoveLabel2X,Label2Y
Source.MoveLabel1X,Label1Y
EndIf
Win
EndSub
PrivateSubLabel2_MouseDown（IndexAsInteger,ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle）IfButton=vbLeftButtonThen'如果按下鼠标左键
'记录下要拖动控件的位置
Label2X=Label2（Index）.Left
Label2Y=Label2（Index）.Top
Label2（Index）.Drag1'启动拖动操作
EndIf
EndSub
PrivateSubLabel2_MouseUp（IndexAsInteger,ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle）Label2（Index）.Drag2'结束拖动操作
EndSub
PrivateSubWin（）
DimwinnerAsInteger
DimiAsInteger
DimanswerAsInteger
'对于给定的标签控件数组中的任一标签控件，可以落在符合要求（对应位置应显示对应数字）
'的八个位置中的任一位置
'利用循环语句对标签控件数组中的每个标签控件进行检查，如果其落在某一符号要求的位置，
'则变量winner的值加1，如果所有标签控件都落在符号要求的位置，则变量winner的值应为8
Fori=0To7
IfLabel2（i）.Left=0AndLabel2（i）.Top=0And_
Label2（i）.Caption=0Then
winner=winner+1
ElseIfLabel2（i）.Left=Label2（i）.WidthAndLabel2（i）.Top=0And_
Label2（i）.Caption=1Then
winner=winner+1
ElseIfLabel2（i）.Left=2*Label2（i）.WidthAndLabel2（i）.Top=0And_
Label2（i）.Caption=2Then
winner=winner+1
ElseIfLabel2（i）.Left=0AndLabel2（i）.Top=Label2（i）.HeightAnd_
Label2（i）.Caption=3Then
winner=winner+1
ElseIfLabel2（i）.Left=Label2（i）.WidthAndLabel2（i）.Top=Label2（i）.HeightAnd_Label2（i）.Caption=4Then
winner=winner+1
ElseIfLabel2（i）.Left=2*Label2（i）.WidthAndLabel2（i）.Top=Label2（i）.HeightAnd_Label2（i）.Caption=5Thenwinner=winner+1
ElseIfLabel2（i）.Left=0AndLabel2（i）.Top=2*Label2（i）.HeightAnd_
Label2（i）.Caption=6Then
winner=winner+1
ElseIfLabel2（i）.Left=Label2（i）.WidthAndLabel2（i）.Top=2*Label2（i）.HeightAnd_Label2（i）.Caption=7Then
winner=winner+1
EndIf
Nexti
Ifwinner=8Then
MsgBox"恭喜您，胜利了！
",0+64+0,"提示"Picture1.Enabled=False
answer=MsgBox（"还继续吗？
",4+32+0,"提示"）
Ifanswer=vbYesThen
Commandl.Enabled=True
Else
End
EndIf
EndIf
EndSub
弹球游戏
Dimx_stepAsInteger
Dimy_stepAsInteger
PrivateSubcommand1_Click（）
IfTimer1.Enabled=TrueThen
Timer1.Enabled=False
Else
Timer1.Enabled=True
EndIf
Ifcommand1.Caption="暂停"Thencommand1.Caption="继续"Else
command1.Caption="暂停
EndIf
EndSub
PrivateSubForm_Load（）
x_step=200
y_step=200
EndSub
PrivateSubPicture1_KeyDown（KeyCodeAsInteger,ShiftAsInteger）
IfKeyCode=37Then
IfLine1.X1<0Then
Line1.X1=0:
Line1.X2=2000
Else
Line1.X1=Line1.X1-100:
Line1.X2=Line1.X2-100
EndIf
EndIf
IfKeyCode=39Then
IfLine1.X1>Picture1.WidthThen
Line1.X1=Picture1.Width-2000:
line2.X2=Picture.Width
Else
Line1.X1=Line1.X1+100:
Line1.X2=Line1.X2+100
EndIf
EndIf
EndSub
PrivateSubTimer1_Timer（）
IfShape1.Top<0Then
Shape1.Top=0:
y_step=-y_step
EndIf
IfShape1.Left<0Then
Shape1.Left=0
x_step=-x_step
EndIf
IfShape1.Left>Picture1.Width-Shape1.WidthThen
Shape1.Left=Picture1.Width-Shape1.Width
x_step=-x_step
EndIf
IfShapel.Left>=Linel.XIAndShapel.Left<=Line1.X2AndShapel.Top>=Linel.YI-Shapel.HeightThen
Shapel.Top=Linel.YI-Shapel.Heighty_step=-y_step*1.01x_step=x_step*1.01
Label2.Caption=Label2.Caption+1
EndIf
Shape1.Top=Shape1.Top+y_step
Shape1.Left=Shape1.Left+x_step
IfShape1.Top>=Picture1.Height-Shape1.HeightThen
MsgBox"游戏结束"command1.Caption="开始Timer1.Enabled=False
Shape1.Top=1000
Label2.Caption=0
EndIf
EndSub
打字游戏
:
竽ifiFF希iS匿述:
DimscoreAsInteger
DimspeedAsInteger
DimtypetimeAsInteger
PrivateSubinit（）
Randomize
lblletter1.Caption=Chr（Int（Rnd*42）+48）lblletter1.Left=Int（Rnd*2800）+1lblletter1.Top=0
EndSub
PrivateSubinit1（）
Randomizelblletter2.Caption=Chr（Int（Rnd*25）+97）lblletter2.Left=Int（Rnd*2800）+1lblletter2.Top=0
EndSub
PrivateSubCommand1_Click（）
score=Int（lblscore.Text）
init
init1
Timer1=True
Timer2=True
HScroll1.Enabled=False
Command1.Enabled=False
Command2.Enabled=False
HScroll1.Enabled=False
Iflbltime.Text<=0Then
Timer1=False
Timer2=False
lblletter1.Caption=""lblletter2.Caption=""
EndIf
EndSub
PrivateSubCommand2_Click（）typetime=InputBox（"请输入打字时间。
","时间设置"）Iftypetime<=0Then
lbltime.Text=60
EndIflbltime.Text=typetimeEndSub
PrivateSubForm_KeyPress（KeyAsciiAsInteger）IfChr（KeyAscii）=lblletter1.CaptionThen
score=score+1lblscore.Text=scoreinitEndIfIfChr（KeyAscii）=lblletter2.CaptionThen
score=score+1lblscore.Text=scoreinit1
EndIfEndSub
PrivateSubForm_Load（）Timer1.Enabled=FalseTimer2.Enabled=Falselblletter1.AutoSize=Truelblletter2.AutoSize=Truelblletter1.Caption=""lblletter2.Caption=""lblscore.Text=0lblspeed.Caption=100lbltime.Text=60HScroll1.Max=200HScroll1.Min=20HScroll1.SmallChange=5HScroll1.LargeChange=20HScroll1.Value=100EndSub
PrivateSubHScroll1_Change（）lblspeed.Caption=HScroll1.ValueEndSub
PrivateSubTimer1_Timer（）lblletter1.Top=lblletter1.Top+lblspeed.Caption
Iflblletter1.Top>=4335Then
Callinit
EndIf
lblletter2.Top=lblletter2.Top+lblspeed.CaptionIflblletter2.Top>=4335Then
Callinit1
EndIf
EndSub
PrivateSubTimer2_Timer（）
Iflbltime.Text>0Then
lbltime.Text=lbltime.Text-1
Else:
SelectCasescore/（typetime/60）
CaseIs<=40
MsgBox（"不要放弃再试一次！
"）
Case40To80
MsgBox（"太棒了，继续努力！
"）
Case80To120
MsgBox（"坚持下去，你将成为一个打字高手！
"）CaseIs>120
MsgBox（"祝贺你！
你已经是一个打字高手！
"）EndSelectTimer1=FalseTimer2=FalseHScroll1.Enabled=TrueCommand1.Enabled=TrueCommand2.Enabled=TrueHScroll1.Enabled=Trueinitinit1
EndIf
EndSub
点灯游戏
PrivateSubForm_Load（）
Form1.Scale（0,12）-（12,0）
Fori=1To11Line（1,i）-（11,i）Line（i,1）-（i,11）
Nexti
EndSub
Subfill_color（X,Y）
IfPoint（X,Y）=vbWhiteThen
Line（Int（X）,Int（Y））-（Int（X+1）,Int（Y+1））,vbBlack,BF
Else
Line（Int（X）,Int（Y））-（Int（X+1）,Int（Y+1））,vbWhite,BF
EndIf
EndSub
PrivateSubForm_MouseDown（ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle）
IfX>=1AndX<=11AndY>=1AndY<=11Then
Callfill_color（X,Y）
IfX>=1AndX<=11AndY+1>=1AndY+1<=11Then
Callfill_color（X,Y+1）
EndIf
IfX>=1AndX<=11AndY-1>=1AndY-1<=11Then
Callfill_color（X,Y-1）
EndIf
IfX+1>=1AndX+1<=11AndY>=1AndY<=11ThenCallfill_color（X+1,Y）
EndIf
IfX-1>=1AndX-1<=11AndY>=1AndY<=11ThenCallfill_color（X-1,Y）
EndIf
EndIf
CallForm_Load
EndSub
猜数字
DimnumberAsInteger
PrivateSubCommand1_Click（）
DimguessAsInteger,diffAsIntegerguess=Val（Text1.Text）
Ifguess=-1Then
MsgBox（"要猜的数是"&number）Text1.Text=""
Text1.SetFocus
ExitSub
EndIf
diff=Abs（number-guess）
SelectCasediff
Case0
MsgBox（"恭喜你猜对了！
"）
Case2,Is<2
MsgBox（"接近了，再努力！
"）
Case10,Is<12
MsgBox（"有些远，再努力！
"）
CaseElse
MsgBox（"太远了，继续努力！
"）
EndSelect
SelectCasediff
CaseIs<>0
Text1.Text=""Text1.SetFocus
EndSelect
EndSub
PrivateSubForm_Load（）
MsgBox（"计算机产生了一个1~100之间的整数，"&Chr（10）&"请您猜出这个数是多少。
"&Chr（10）&"如果输入-1，则停止猜数，并输出要猜的数。
"）
number=Int（100*Rnd）+1
EndSub
PrivateSubLabel1_Click（）
EndSub猜笑脸
PrivateSubCommand1_Click（IndexAsInteger）DimaAsInteger,iAsInteger
Randomizea=Int（Rnd*4）
Command1（a）.Enabled=False
Command1（a）.DisabledPicture=LoadPicture（"267.gif"）
Ifa=IndexThen
Label1.Caption="你猜对啦，真棒！
"Else
Label1.Caption="你猜错啦，我在这哩！
"EndIf
Fori=0To3
Command1（i）.Enabled=FalseNexti
EndSub
PrivateSubCommand2_Click（）
DimiAsInteger
Fori=0To3
Command1（i）.Enabled=TrueCommand1（i）.DisabledPicture=LoadPicture（""）
Nexti
Label1.Caption="猜猜我在哪儿？
"
EndSub
PrivateSubCommand3_Click（）
End
EndSub
升级会员 