vb俄罗斯方块.docx
《vb俄罗斯方块.docx》由会员分享，可在线阅读，更多相关《vb俄罗斯方块.docx（19页珍藏版）》请在冰豆网上搜索。
vb俄罗斯方块
流程图
画面规划
画面规划如图1所示
图1
说明如下：
：
游戏窗口（Form）。
为了避免因改变窗口大小而造成画面呈现不美观，将BorderStyle属性设定为3，即无法以窗口边缘进行窗口大小调整。
：
积分框（Frame）
：
累计数框（Frame）
：
分数（Label）
：
等级（Label）
：
构成下一个动作方块所需组件（Image）。
程序设计阶段将Visible设为False，程序执行阶段再依需要改变属性值。
：
构成地图方块所需组件（Image）。
程序设计阶段将Visible设为False，程序执行阶段再依需要改变属性值。
：
构成现在动作方块所需组件（Image）。
程序设计阶段将Visible设为False，程序执行阶段再依需要改变属性值。
：
定时器（Timer）。
：
方块图形存储组件（ImageList）。
1.游戏使用说明
上方向键旋转方块，左右和下方向键移动方块，空格键能让方块骤降，pause按键能暂停游戏。
每消除一行得100分，初始等级为1级，满3000分升1级，同时方块下降的速度也变快。
程序代码：
PrivateTypeblocktype
intblockarray（3,4,4）AsInteger'方块数组
blockpictureAsInteger'方块图形
EndType
'所有方块形状数据
Dimblockarray（）Asblocktype'方块类型数组
'现在方块
DimnowblocktypeAsInteger'方块类型
DimnowblockmodeAsInteger'方块方向
DimnowblockpictureAsInteger'方块图案
DimnowblockxAsInteger'x坐标
DimnowblockyAsInteger'y坐标
DimnowblockwAsInteger'方块宽
DimnowblockhAsInteger'方块高
'下一个方块
DimnextblocktypeAsInteger'方块类型
DimnextblockpictureAsInteger'方块图形
'地图数据
DimmapxsAsInteger'地图横向格数
DimmapysAsInteger'地图纵向格数
Dimmaparray（）AsInteger'地图数组
Dimmappicturearray（）AsInteger'地图中所代表的图案
DimmapxAsInteger'地图x坐标
DimmapyAsInteger'地图y坐标
DimdelcountAsInteger'删除行数计数器
'游戏进行数据
DimscoreAsDouble'游戏分数
DimlevelAsInteger'游戏级数
DimspeedAsInteger'游戏速度
PrivateDeclareSubSleepLib"kernel32"（ByValdwMillisecondsAsLong）
'窗体加载
PrivateSubform_load（）
Randomize
Callsetmap'设定地图数据
Callsetformsize'设定窗体大小
Callsetgamedata'初始化游戏数据
Callsetblock'设定各种方块数据
Callcreatenextblock'产生下一方块
Callcreatenowblock'产生现在方块
Timer1.Enabled=True
Timer1.Interval=speed
EndSub
'设定地图数据
PrivateSubsetmap（）
mapx=0
mapy=735
mapxs=14
mapys=18
nowblockw=375
nowblockh=375
ReDimmaparray（mapxs-1,mapys-1）
ReDimmappicturearray（mapxs-1,mapys-1）
'将地图数据清空,并加载图形组件
ForX=0Tomapxs-1
ForY=0Tomapys-1
Loadimgmapblock（imgmapblock.Count）
imgmapblock（imgmapblock.Count-1）._
Move（X*nowblockw+mapx）,_
（Y*nowblockh+mapy）,_
nowblockw,_
nowblockh
imgmapblock（imgmapblock.Count-1）.Visible=False
maparray（X,Y）=0
mappicturearray（X,Y）=0
NextY
NextX
EndSub
'设定窗体大小位置
PrivateSubsetformsize（）
DimfrmleftAsInteger
DimfrmtopAsInteger
DimfrmwAsInteger
DimfrmhAsInteger
frmleft=（Screen.Width-Me.Width）/2
frmtop=（Screen.Height-Me.Height）/2
frmw=nowblockw*mapxs+（Me.Width-Me.ScaleWidth）
frmh=nowblockh*mapys+（Me.Height-Me.ScaleHeight）
Me.Movefrmleft,frmtop,frmw,frmh+735
imgnowblock（0）.Width=nowblockw
imgnowblock（0）.Height=nowblockh
imgmapblock（0）.Width=nowblockw
imgmapblock（0）.Height=nowblockh
EndSub
'初始化游戏进行数据
PrivateSubsetgamedata（）
score=0
level=1
speed=800
lbscore（0）.Caption=score
lblevel（0）.Caption=level
EndSub
'设定方块数据
PrivateSubsetblock（）
ReDimblockarray（6）
DimintcountAsInteger
blockarray（0）.intblockarray（0,2,1）=1'倒T形
blockarray（0）.intblockarray（0,1,2）=1
blockarray（0）.intblockarray（0,2,2）=1
blockarray（0）.intblockarray（0,3,2）=1
blockarray
（1）.intblockarray（0,1,1）=1'L形
blockarray
（1）.intblockarray（0,1,2）=1
blockarray
（1）.intblockarray（0,2,2）=1
blockarray
（1）.intblockarray（0,3,2）=1
blockarray
（2）.intblockarray（0,3,1）=1'倒L形
blockarray
（2）.intblockarray（0,1,2）=1
blockarray
（2）.intblockarray（0,2,2）=1
blockarray
（2）.intblockarray（0,3,2）=1
blockarray（3）.intblockarray（0,1,2）=1'一字形
blockarray（3）.intblockarray（0,2,2）=1
blockarray（3）.intblockarray（0,3,2）=1
blockarray（3）.intblockarray（0,4,2）=1
blockarray（4）.intblockarray（0,1,1）=1'Z字形
blockarray（4）.intblockarray（0,2,1）=1
blockarray（4）.intblockarray（0,2,2）=1
blockarray（4）.intblockarray（0,3,2）=1
blockarray（5）.intblockarray（0,2,1）=1'倒Z字形
blockarray（5）.intblockarray（0,3,1）=1
blockarray（5）.intblockarray（0,1,2）=1
blockarray（5）.intblockarray（0,2,2）=1
Fori=0To3
blockarray（6）.intblockarray（i,2,2）=1'田字形
blockarray（6）.intblockarray（i,2,3）=1
blockarray（6）.intblockarray（i,3,2）=1
blockarray（6）.intblockarray（i,3,3）=1
Nexti
Fori=0To5'依序为倒T形，L形，倒L形，一字形，Z形和倒Z形
Forj=1To3'每一形状要做三次旋转，每次顺时针90
intcount=0
Ifi>2And（jMod2=0）Then
ForX=0To4
ForY=0To4
blockarray（i）._
intblockarray（j,X,Y）=blockarray（i）._
intblockarray（（j-1）,4-Y,X）
Ifblockarray（i）.intblockarray（j,X,Y）=1Then
intcount=intcount+1
EndIf
Ifintcount>=4ThenExitFor
NextY
Ifintcount=4ThenExitFor
NextX
Else
ForX=0To4
ForY=0To4
blockarray（i）.intblockarray（j,X,Y）=_
blockarray（i）.intblockarray（（j-1）,Y,4-X）
Ifblockarray（i）.intblockarray（j,X,Y）=1Then
intcount=intcout+1
EndIf
Ifintcount>=4ThenExitFor
NextY
Ifintcount>=4ThenExitFor
NextX
EndIf
Nextj
Nexti
EndSub
'产生下一个方块图形
PrivateSubcreatenextblock（）
DimintcountAsInteger
nextblocktype=Rnd（）*UBound（blockarray）'随机数产生方块形态
'随机数产生方块图案
nextblockpicture=Rnd（）*（iglblockpicture.ListImages.Count-1）+1
'第一次初始将组件动态新增至4个
Ifimgnextblock.Count<4Then
Do
Loadimgnextblock（imgnextblock.Count）
LoopWhileimgnextblock.Count<4
EndIf
'将下一个方块画在窗体上方
intcount=0
ForX=0To4
ForY=1To2
Ifblockarray（nextblocktype）.intblockarray（0,X,Y）=1Then
Setimgnextblock（intcount）.Picture=iglblockpicture.ListImages（nextblockpicture）.Picture
imgnextblock（intcount）.Move（2000+X*195）,（30+Y*195）,195,195
imgnextblock（intcount）.Visible=True
intcount=intcount+1
EndIf
Ifintcount>=4ThenExitFor
NextY
Ifintcount>=4ThenExitFor
NextX
EndSub
'产生现在方块形状
PrivateSubcreatenowblock（）
DimintcountAsInteger
DimstrgameoverAsString
nowblocktype=nextblocktype
nowblockpicture=nextblockpicture
nowblockx=（mapxs-5）/2-1
nowblocky=-1
nowblockmode=0
'第一次初始将组件动态新增至4个
Ifimgnowblock.Count<4Then
Do
Loadimgnowblock（imgnowblock.Count）
LoopWhileimgnowblock.Count<4
EndIf
'检查新产生的方块是否可以放在地图中
Ifcheckput（nowblockx,nowblocky,nowblockmode）=FalseThen
strgameover=MsgBox（"你输了，继续玩吗？
",vbQuestion+vbYesNo,"游戏结束"）
Ifstrgameover=vbNoThen
End
Else
DoWhileimgmapblock.Count>1
Unloadimgmapblock（imgmapblock.Count-1）
Loop
Callform_load
EndIf
Else
Calldrawblock'画出方块
Callcreatenextblock
EndIf
EndSub
'键盘事件
PrivateSubform_keydown（keycodeAsInteger,shiftAsInteger）
IfTimer1.Enabled=TrueOrkeycode=vbKeyPauseThen
SelectCasekeycode
CasevbKeyUp
nowblockmode=nowblockmode+1
Ifnowblockmode>3Thennowblockmode=0
Ifcheckput（nowblockx,nowblocky,nowblockmode）=FalseThen
nowblockmode=nowblockmode-1
Ifnowblockmode<0Thennowblockmode=3
Else
Calldrawblock'画出方块
EndIf
CasevbKeyDown
Ifcheckput（nowblockx,nowblocky+1,nowblockmode）=TrueThen
nowblocky=nowblocky+1
Calldrawblock
Else
Callcheckbottom
EndIf
CasevbKeyLeft
Ifcheckput（nowblockx-1,nowblocky,nowblockmode）=TrueThen
nowblockx=nowblockx-1
Calldrawblock
EndIf
CasevbKeyRight
Ifcheckput（nowblockx+1,nowblocky,nowblockmode）=TrueThen
nowblockx=nowblockx+1
Calldrawblock
EndIf
CasevbKeySpace
DoWhilecheckput（nowblockx,nowblocky+1,nowblockmode）=True
nowblocky=nowblocky+1
Loop
Calldrawblock
Callcheckbottom
CasevbKeyPause
Timer1.Enabled=NotTimer1.Enabled
CasevbKeyEscape
UnloadMe
EndSelect
EndIf
EndSub
'画出方块
PrivateSubdrawblock（）
DimintcountAsInteger
intcount=0
ForX=nowblockxTo（nowblockx+4）
ForY=nowblockyTo（nowblocky+4）
Ifblockarray（nowblocktype）.intblockarray（nowblockmode,（X-nowblockx）,（Y-nowblocky））=1Then
Setimgnowblock（intcount）.Picture=iglblockpicture.ListImages（nowblockpicture）.Picture
imgnowblock（intcount）.Move（X*nowblockw+mapx）,（Y*nowblockh+mapy）,nowblockw,nowblockh
imgnowblock（intcount）.Visible=True
intcount=intcount+1
EndIf
Ifintcount>=4ThenExitFor
NextY
Ifintcount>=4ThenExitFor
NextX
EndSub
'检查方块是否可以放置
PrivateFunctioncheckput（cxAsInteger,cyAsInteger,cmAsInteger）AsBoolean
checkput=True
ForX=cxTo（cx+4）
ForY=cyTo（cy+4）
Ifblockarray（nowblocktype）.intblockarray（cm,（X-cx）,（Y-cy））=1Then
IfX<0OrX>（mapxs-1）Or_
Y<0OrY>（mapys-1）Then
checkput=False
Else
Ifmaparray（X,Y）=1Then
checkput=False
EndIf
EndIf
EndIf
Ifintcount>=4ThenExitFor
NextY
Ifcheckput=FalseThenExitFor
NextX
EndFunction
'定时器
PrivateSubTimer1_Timer（）
Ifcheckput（nowblockx,nowblocky+1,nowblockmode）=TrueThen
nowblocky=nowblocky+1
Calldrawblock
Else
Callcheckbottom
EndIf
EndSub
'方块到底检查
PrivateSubcheckbottom（）
Timer1.Enabled=False
CallWirtemap'将到底的方块数据写入地图数组中
Calldeletefull'删除满行
Ifdelcount>0ThenCallreloadmap'假如有刪除行则重新加载地图
Callcheckgamedata'检查游戏数据
Callcreatenowblock'产生新方块
Timer1.Enabled=True
EndSub
'将到底的方块数据写入地图数组中
PrivateSubWirtemap（）
DimintcountAsInteger'方块计数器
intcount=0
ForX=0To4
ForY=0To4
Ifblockarray（nowblocktype）.intblockarray（nowblockmode,X,Y）=1Then
'读取到方块数组中的值为1时，方块计数器加1
intcount=intcount+1
maparray（nowblockx+X,Y+nowblocky）=1
mappicturearray（X+nowblockx,Y+nowblocky）=nowblockpicture
Setimgmapblock（（nowblockx+X）+（nowblocky+Y）*mapxs）.Picture=_
iglblockpicture.ListImages（mappicturearray（（nowblockx+X）,（nowblocky+Y）））.Picture
imgmapblock（（nowblockx+X）+（nowblocky+Y）*mapxs）.Move（（nowblockx+X）*nowblockw+mapx）,_
（（nowblocky+Y）
升级会员 