vb小游戏代码.docx
《vb小游戏代码.docx》由会员分享,可在线阅读,更多相关《vb小游戏代码.docx(14页珍藏版)》请在冰豆网上搜索。
![vb小游戏代码.docx](https://file1.bdocx.com/fileroot1/2023-6/8/4cb8a68e-2e2d-45f6-8cfd-eda8e38440a9/4cb8a68e-2e2d-45f6-8cfd-eda8e38440a91.gif)
vb小游戏代码
数字排序小游戏
OptionExplicit
DimLabel2XAsInteger'记录标签控件数组中要移动的标签控件左上角X的位置
DimLabel2YAsInteger'记录标签控件数组中要移动的标签控件左上角Y的位置
'让标签数组中的每个标签控件上显示的数字是随机的,无重复的
PrivateSubInit()
Randomize
Dima
(7)AsInteger
DimiAsInteger,kAsInteger
Label1.Caption=""
Fori=0To7
a(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()
DimiAsInteger
Picture1.Enabled=False
'在标签中显示游戏说明信息
Label3.Caption="如左图所示,将数字按0-7顺"&vbCrLf&vbCrLf&"序依次排列,即取得胜利。
"'在标签中显示排列规则后的数字顺序
Label1.Caption=0
Fori=0To6
Label2(i).Caption=i+1
Next
EndSubPrivateSubLabel1_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的值应为8Fori=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=5Then
winner=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
Command1.Enabled=True
Else
End
EndIf
EndIf
EndSub
打字游戏
DimscoreAsInteger
DimspeedAsInteger
DimtypetimeAsInteger
PrivateSubinit()
Randomize
lblletter1.Caption=Chr(Int(Rnd*42)+48)
lblletter1.Left=Int(Rnd*2800)+1
lblletter1.Top=0
EndSub
PrivateSubinit1()Randomize
lblletter2.Caption=Chr(Int(Rnd*25)+97)
lblletter2.Left=Int(Rnd*2800)+1
lblletter2.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
EndIf
lbltime.Text=typetime
EndSub
PrivateSubForm_KeyPress(KeyAsciiAsInteger)
IfChr(KeyAscii)=lblletter1.CaptionThen
score=score+1
lblscore.Text=score
init
EndIf
IfChr(KeyAscii)=lblletter2.CaptionThenscore=score+1
lblscore.Text=score
init1
EndIf
EndSub
PrivateSubForm_Load()
Timer1.Enabled=False
Timer2.Enabled=False
lblletter1.AutoSize=True
lblletter2.AutoSize=True
lblletter1.Caption=""
lblletter2.Caption=""
lblscore.Text=0
lblspeed.Caption=100
lbltime.Text=60
HScroll1.Max=200
HScroll1.Min=20
HScroll1.SmallChange=5
HScroll1.LargeChange=20
HScroll1.Value=100
EndSub
PrivateSubHScroll1_Change()
lblspeed.Caption=HScroll1.Value
EndSub
PrivateSubTimer1_Timer()
lblletter1.Top=lblletter1.Top+lblspeed.Caption
Iflblletter1.Top>=4335Then
Callinit
EndIf
lblletter2.Top=lblletter2.Top+lblspeed.Caption
Iflblletter2.Top>=4335Then
Callinit1
EndIf
EndSub
PrivateSubTimer2_Timer()
Iflbltime.Text>0Then
lbltime.Text=lbltime.Text-1
Else:
SelectCasescore/(typetime/60)
CaseIs<=40MsgBox("不要放弃再试一次!
")
Case40To80
MsgBox("太棒了,继续努力!
")
Case80To120
MsgBox("坚持下去,你将成为一个打字高手!
")
CaseIs>120
MsgBox("祝贺你!
你已经是一个打字高手!
")
EndSelect
Timer1=False
Timer2=False
HScroll1.Enabled=True
Command1.Enabled=True
Command2.Enabled=True
HScroll1.Enabled=True
init
init1
EndIf
EndSub
点灯游戏PrivateSubForm_Load()
Form1.Scale(0,12)-(12,0)
Fori=1To11
Line(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<=11Then
Callfill_color(X+1,Y)
EndIf
IfX-1>=1AndX-1<=11AndY>=1AndY<=11Then
Callfill_color(X-1,Y)
EndIf
EndIf
CallForm_Load
EndSub
猜数字
DimnumberAsInteger
PrivateSubCommand1_Click()
DimguessAsInteger,diffAsInteger
guess=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
Randomize
a=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=False
Nexti
EndSub
PrivateSubCommand2_Click()
DimiAsInteger
Fori=0To3
Command1(i).Enabled=True
Command1(i).DisabledPicture=LoadPicture("")
Nexti
Label1.Caption="猜猜我在哪儿?
"
EndSub
PrivateSubCommand3_Click()
End
EndSub