vb 俄罗斯方块设计程序及分析.docx
《vb 俄罗斯方块设计程序及分析.docx》由会员分享,可在线阅读,更多相关《vb 俄罗斯方块设计程序及分析.docx(14页珍藏版)》请在冰豆网上搜索。
![vb 俄罗斯方块设计程序及分析.docx](https://file1.bdocx.com/fileroot1/2023-3/31/eb39ac6a-dadb-48a3-b999-b58dd096e131/eb39ac6a-dadb-48a3-b999-b58dd096e1311.gif)
vb俄罗斯方块设计程序及分析
*************俄罗斯方块DIY***************
键盘控制方法:
1.左右光标键控制方块左右移动;
2.上光标键控制方块顺时针旋转90度;
3.下光标键控制方块加速向下移动。
设计过程:
(一)在VB6.0中新建一个标准EXE工程
(二)建立一个窗体,窗体属性设置如下:
名称=frmErs
Caption="俄罗斯方块1.12"
(三)在窗体上添加两个图片框,属性设置如下:
(1)名称=picPlay
AutoRedraw=True
BackColor =&H00FF0000& '蓝色
(2)名称=picNext
AutoRedraw=True
BackColor =&H00FF0000& '蓝色
(四)在窗体上再添加一个标签,属性设置如下:
名称=lblFenShu
(五)用菜单编辑器制作如下菜单:
(1)一级菜单项:
标题="文件(&F)"
名称=mnuSet
下属二级菜单项:
标题="退出"
名称=mnuExit
(2)一级菜单项:
标题="帮助(&H)"
名称=mnuHelp
下属二级菜单项:
标题="操作提示"
名称=mnuTopic
(六)在窗体代码窗口输入如下代码:
OptionExplicit
PrivateSubForm_KeyDown(KeyCodeAsInteger,ShiftAsInteger)
'按键代码传入Main()主程序中
gKeyRef=KeyCode
EndSub
PrivateSubForm_Load()
Me.Top=0
Me.KeyPreview=True
picPlay.ScaleMode=3 'Pixel
picNext.ScaleMode=3 'Pixel
EndSub
PrivateSubForm_Unload(CancelAsInteger)
End
EndSub
PrivateSubmnuExit_Click()
'退出
UnloadMe
EndSub
PrivateSubmnuTopic_Click()
DimMsgAsString
Msg="键盘控制方法:
"&vbCrLf
Msg=Msg&"1.左右光标键控制方块左右移动;"&vbCrLf
Msg=Msg&"2.上光标键控制方块顺时针旋转90度;"&vbCrLf
Msg=Msg&"3.下光标键控制方块加速向下移动。
"&vbCrLf&vbCrLf
Msg=Msg&"福建南平梁远海20000年10月提供"&vbCrLf
Msg=Msg&" E-Mail:
dayang@"
MsgBoxMsg,vbOKOnly+vbQuestion,Me.Caption
EndSub
PrivateSubpicPlay_KeyDown(KeyCodeAsInteger,ShiftAsInteger)
'按键代码传入Main()主程序中
gKeyRef=KeyCode
EndSub
(七)添加一个新模块moudel1,并输入如下代码:
OptionExplicit
PublicgKeyRefAsInteger
'游戏操作按键码值全局变量
DimmErsBar(0To8)AsLong
'俄罗斯方块形状定义,数组下标分配如下:
' +---+---+---+
' |0|1|2|
' +---+---+---+
' |7|8|3|
' +---+---+---+
' |6|5|4|
' +---+---+---+
'之所以这样定义,是为了方便方块类型设置和旋转判断
'数组元素取值为:
是空白=0,是方块构件=1
DimmErsPD(2,2)AsLong
'将二维坐标系转化为mErsBar()对应下标,以进行方块移动的判断
'数组元素取值如下:
' mErsPD mErsPD mErsPD
' (0,0) = 0 (1,0) = 1 (2,0) = 2
' (0,1) = 7 (1,1) = 8 (2,1) = 3
' (0,2) = 6 (1,2) = 5 (2,2) = 4
'应用样式:
IfmErsBar(mErsPD(x,y))=0Then...
DimmPlayWindow() AsLong
'运动小窗口的屏幕状况数组
'数组大小在子程序NewSatrt()中根据mPlayKuan,mPlayGao的值重定义
'即ReDimmPlayWindow(-1TomPlayKuan+2,1TomPlayGao+2)AsLong
'取上面的下标范围是为了方块运动判断设计上的方便,
'方块实际运动范围在(1,1)-(mPlayKuan,mPlayGao)之间
'数组元素取值为:
是空白=0,是方块构件>0,初始值=-9
DimmPlayKuanAsLong,mPlayGaoAsLong
'运动小窗口的相对宽度(容纳方块小构件的列数)和相对高度(容纳方块小构件的行数)
DimmPlayMovXAsLong,mPlayMovYAsLong
'运动小窗口内方块移动中所处位置的左上角相对坐标
DimmPlayX_SIZEAsLong,mPlayY_SIZEAsLong
'运动小窗口内方块小构件实际宽度和高度
DimmPlayBkColorAsLong
'运动小窗口背景色
DimmNextX_SIZEAsLong,mNextY_SIZEAsLong
'预览小窗口内方块小构件实际宽度和高度
DimmNextBkColorAsLong
'预览小窗口背景色
PrivateSubBarDef(ByValkAsLong)
'定义方块形状子程序
DimjAsLong
Dima1AsLong,a2AsLong
Dima3AsLong,a4AsLong
Forj=0To8:
mErsBar(j)=0:
Nextj
SelectCasek
Case0 '长条
a1=0:
a2=2:
a3=-1:
a4=-1
Case1 '小块1*1
a1=1:
a2=1:
a3=-1:
a4=-1
Case2 '7字
a1=0:
a2=2:
a3=7:
a4=7
Case3 '反7字
a1=0:
a2=3:
a3=-1:
a4=-1
Case4 '凹字
a1=0:
a2=3:
a3=7:
a4=7
Case5 '凸字
a1=0:
a2=2:
a3=8:
a4=8
Case6 '2字
a1=1:
a2=1:
a3=6:
a4=8
Case7 '反2字
a1=1:
a2=2:
a3=7:
a4=8
Case8 '墙角
a1=1:
a2=3:
a3=-1:
a4=-1
Case9 '田字
a1=0:
a2=1:
a3=7:
a4=8
CaseElse'大块3*3(有出现即类型序号超出k值)
a1=0:
a2=8:
a3=-1:
a4=-1
EndSelect
Forj=a1Toa2:
mErsBar(j)=1:
Nextj
Ifa3>-1Anda4>-1Then
Forj=a3Toa4:
mErsBar(j)=1:
Nextj
EndIf
EndSub
PrivateSubBarViewPlay(ByValBarModeAsLong)
'在运动小窗口内显示或消隐方块的子程序
DimiAsLong,jAsLong
Fori=0To2
Forj=0To2
IfmErsBar(mErsPD(j,i))=1Then
CallSmallBarPlay(mPlayMovX+j,mPlayMovY+i,BarMode)
mPlayWindow(mPlayMovX+j,mPlayMovY+i)=BarMode
EndIf
Nextj
Nexti
EndSub
PrivateSubBarViewNext(ByValBarModeAsLong)
'在预览小窗口内展现下一轮方块的子程序
DimiAsLong,jAsLong
Fori=0To2 '清除旧方块
Forj=0To2
CallSmallBarNext(j+2,i+2,0)
Nextj
Nexti
Fori=0To2 '显示新方块
Forj=0To2
IfmErsBar(mErsPD(j,i))=1Then
CallSmallBarNext(j+2,i+2,BarMode)
EndIf
Nextj
Nexti
EndSub
SubDelay(ByValddAsDouble)
'延时子程序
DimttAsDouble
tt=Timer+dd
Do:
LoopUntilTimer>=tt
EndSub
PrivateSubLineTestAndClear(CleanToTalAsLong)
'方块停止下落后对各行是否积满进行测试和作相应处理的子程序
DimxAsLong
DimyAsLong
Dimy1AsLong
DimValTmpAsLong
DimCountAsLong
DimCleanAddAsLong
DimttAsLong
DimUpPDAsLong
DimDownPDAsLong
DimMinBetweenAsLong
DimPW()AsLong
CleanAdd=0
y=mPlayGao
'统计每行方块构件数并作相应处理的两个步骤:
Do
'步骤之一:
统计本行已容纳的方块构件数
Count=0
Forx=1TomPlayKuan
IfmPlayWindow(x,y)>0ThenCount=Count+1
Nextx
'步骤之二:
如果本行积满则分三小步处理:
IfCount=mPlayKuanThen
'第一步:
行积满计数
CleanAdd=CleanAdd+1
'第二步:
上方各行向下搬移
Ify>1Then
Fory1=yTo2Step-1
Forx=1TomPlayKuan
ValTmp=mPlayWindow(x,y1-1)
CallSmallBarPlay(x,y1,ValTmp)
mPlayWindow(x,y1)=ValTmp
Nextx
Nexty1
y=y+1
EndIf
'第三步:
清除顶行冗余
Forx=1TomPlayKuan
CallSmallBarPlay(x,1,0)
mPlayWindow(x,1)=0
Nextx
DoEvents
EndIf
y=y-1
LoopUntily<1
IfCleanAdd=0ThenExitSub
CleanToTal=CleanToTal+CleanAdd
'检测并处理各处悬空方块的六个步骤:
Do
'步骤之一:
数组复制
PW=mPlayWindow
'步骤之二:
遍历所有与底行相邻的方块构件并标记为-1
y=mPlayGao
Forx=1TomPlayKuan
IfPW(x,y)>0Then
CallLocMe(PW(),x,y,-1)
EndIf
Nextx
'步骤之三:
从找到的第一个悬空方块构件出发遍历所有与本构件相邻的构件并标记为-2
tt=0
Fory=mPlayGao-1To1Step-1
Forx=1TomPlayKuan
IfPW(x,y)>0Then
CallLocMe(PW(),x,y,-2)
tt=-1
ExitFor
EndIf
Nextx
Iftt=-1ThenExitFor
Nexty
'步骤之四:
没有悬空方块则退出循环
Iftt<>-1ThenExitDo
'步骤之五:
计算标记为-2的悬空方块与下方的方块的最小垂直距离MinBetween
MinBetween=mPlayGao
Forx=1TomPlayKuan
UpPD=0
Fory=mPlayGao-1To1Step-1
IfPW(x,y)=-2ThenUpPD=y:
ExitFor
Nexty
IfUpPD<>0Then
DownPD=mPlayGao+1
Fory=UpPD+1TomPlayGao
IfPW(x,y)=-1OrPW(x,y)>0ThenDownPD=y:
ExitFor
Nexty
ValTmp=DownPD-UpPD-1
IfValTmp>0AndValTmp EndIf
Nextx
'步骤之六:
标记为-2的悬空方块下移MinBetween行
Forx=1TomPlayKuan
Fory=mPlayGao-1To1Step-1
IfPW(x,y)=-2Then
ValTmp=mPlayWindow(x,y)
mPlayWindow(x,y)=0
CallSmallBarPlay(x,y,0)
mPlayWindow(x,y+MinBetween)=ValTmp
CallSmallBarPlay(x,y+MinBetween,ValTmp)
EndIf
Nexty
Nextx
DoEvents
Loop
'递归调用(重新检查悬空方块下沉后各行积满情况)
CallLineTestAndClear(CleanToTal)
EndSub
PrivateSubLocMe(PW()AsLong,ByValxAsLong,ByValyAsLong,ByValNumValAsLong)
'从坐标为(x,y)的方块构件出发遍历相邻方块构件并标记为NumVal的子程序
ReDimDingWei(0TomPlayGao*mPlayKuan,1To2)AsLong
DimttAsLong
DimpdAsLong
pd=PW(x,y)
IfNot(pd>0)ThenExitSub
tt=0
Do
Ify>1Theny=y-1:
GoSubLoc1:
y=y+1
IfxGoSubLoc1:
x=x-1
IfyGoSubLoc1:
y=y-1
Ifx>1Thenx=x-1:
GoSubLoc1:
x=x+1
Iftt=0ThenPW(x,y)=NumVal:
ExitDo
tt=tt-1
x=DingWei(tt,1)
y=DingWei(tt,2)
Loop
ExitSub
Loc1:
IfPW(x,y)>0Then
PW(x,y)=NumVal
DingWei(tt,1)=x
DingWei(tt,2)=y
tt=tt+1
EndIf
Return
EndSub
PrivateSubMain()
'主程序
DimSpeedAsDouble '方块运动速度控制
DimiKeyAsInteger '按键代码
DimFenShuAsLong '计算得分
DimCleanToTalAsLong'本轮积满而被清除的行数统计
DimBarModeAsLong '方块显示模式
Dimk1AsLong '本轮将出现的方块类型序号
Dimk2AsLong '下一轮将出现的方块类型序号
DimDefColorAsLong '标签前景色
DimStrMsgAsString '标签信息
DimRefAsInteger '游戏结束对话框返回值
frmErs.Show
RESTART:
'游戏开始
FenShu=0
CleanToTal=0
GoSubJiFen
mPlayKuan=12 '方块运动小窗口的宽度(列数)设置(建议6>=mPlayKuan>=50)
mPlayGao=19 '方块运动小窗口的高度(行数)设置(建议6>=mPlayGao>=50)
CallNewStart
RandomizeTimer
'方块类型有10种,序号为0-9,在BarDef()子程序中定义
k2=Int(Rnd*10)
Do
k1=k2
k2=Int(Rnd*10)
BarMode=Int(Rnd*3)+1
CallBarDef(k2) '定义下一轮方块
CallBarViewNext(BarMode) '预览下一轮方块
CallBarDef(k1) '定义本轮方块
mPlayMovX=(mPlayKuan+1)\2
mPlayMovY=1
IfMovDownTest()=FalseThenExitDo
gKeyRef=0
Do
CallBarViewPlay(BarMode)'显现本轮方块
Speed=Timer+0.4
Do
DoEvents '以便从frmErs的键盘事件中传回按键代码gKeyRef
iKey=gKeyRef
IfiKey<>0Then
gKeyRef=0
SelectCaseiKey
CasevbKeyLeft '左光标键
CallBarViewPlay(0)
IfMovLeftTest()=Tru