vb 俄罗斯方块设计程序及分析.docx

资源描述

vb 俄罗斯方块设计程序及分析.docx

《vb 俄罗斯方块设计程序及分析.docx》由会员分享，可在线阅读，更多相关《vb 俄罗斯方块设计程序及分析.docx（14页珍藏版）》请在冰豆网上搜索。

vb 俄罗斯方块设计程序及分析.docx

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

'统计每行方块构件数并作相应处理的两个步骤：

'步骤之一：

统计本行已容纳的方块构件数

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

'检测并处理各处悬空方块的六个步骤：

'步骤之一：

数组复制

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

Ify>1Theny=y-1:

GoSubLoc1:

y=y+1

Ifx

GoSubLoc1:

x=x-1

Ify

GoSubLoc1:

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）

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

CallBarViewPlay（BarMode）'显现本轮方块

Speed=Timer+0.4

DoEvents '以便从frmErs的键盘事件中传回按键代码gKeyRef

iKey=gKeyRef

IfiKey<>0Then

gKeyRef=0

SelectCaseiKey

CasevbKeyLeft '左光标键

CallBarViewPlay（0）

IfMovLeftTest（）=Tru

展开阅读全文