扫雷程序设计.docx

资源描述

扫雷程序设计.docx

《扫雷程序设计.docx》由会员分享，可在线阅读，更多相关《扫雷程序设计.docx（30页珍藏版）》请在冰豆网上搜索。

扫雷程序设计.docx

扫雷程序设计

OptionExplicit

'标题栏21

'确定TOP=70

'取消TOP=31

'LEFT=123

'按钮大小60*24

'文本框大小38*18

'文本框高度765431

'Left=72

PrivateSubForm_Load（）

Text1（0）.Text=MHeight

Text1

（1）.Text=MWidth

Text1

（2）.Text=Mines

RemoveMenuLineMe.hWnd,5

EndSub

PrivateSubOKButton_Click（）

LetMHeight=Text1（0）.Text

IfMHeight<9ThenLetMHeight=9

IfMHeight>24ThenLetMHeight=24

LetMWidth=Text1

（1）.Text

IfMWidth<9ThenLetMWidth=9

IfMWidth>30ThenLetMWidth=30

LetMines=Text1

（2）.Text

IfMines<10ThenLetMines=10

IfMines>（MHeight-1）*（MWidth-1）ThenLetMines=（MHeight-1）*（MWidth-1）

FrmMain.Cls

FrmMain.GameStart'开始

UnloadMe

EndSub

PrivateSubCancelButton_Click（）

UnloadMe

EndSub

PrivateSubText1_KeyPress（IndexAsInteger,KeyAsciiAsInteger）

If（KeyAscii<48OrKeyAscii>57）AndKeyAscii<>8ThenKeyAscii=0

EndSub

'PrivateSubHotKey（IndexAsInteger）

'Text1（Index）.SetFocus

'Text1（Index）.SelStart=0

'Text1（Index）.SelLength=Len（Text1（Index）.Text）

'EndSub

'PrivateSubLabel1_Click（）

'HotKey0

'EndSub

'PrivateSubLabel2_Click（）

'HotKey1

'EndSub

'PrivateSubLabel3_Click（）

'HotKey2

'EndSub

OptionExplicit

PrivateConstvbGray=&H848284'灰色

PrivateConstMLeftAsLong=180'雷区距离左侧（按Twips计算）

PrivateConstMTopAsLong=825'雷区距离上部

PrivateConstWAVE_DEFAULT=432'默认声音

PrivateConstWAVE_VICTORY=433'失败声音

PrivateConstWAVE_LOST=434'胜利声音

PrivateConstBMP_GRID_WIDTH=16'格子的宽

PrivateConstBMP_GRID_HEIGHT=16'格子的高

PrivateConstBMP_NUM_WIDTH=13'数字的宽

PrivateConstBMP_NUM_HEIGHT=23'数字的高

PrivateConstBMP_NUM_TOP=16'数字距离上边（菜单底）

PrivateConstBMP_NUM_MINE_LEFT=17'计数器距离左侧

PrivateConstBMP_NUM_TIME_RIGHT=BMP_NUM_WIDTH*3+20'计时器左侧距离窗体右侧

PrivateConstBMP_FACE_WIDTH=24'表情的宽

PrivateConstBMP_FACE_HEIGHT=24'表情的高

PrivateConstBMP_FACE_TOP=16'表情距离上边（菜单底）

PrivateCanPeeperAsBoolean'作弊

'初级9/9/10

'中级16/16/40

'高级30/16/99

'PrivateNoMineAsBoolean

PrivateSubInithDC（）

DimIAsLong

DimhBmpAsStdPicture

'从资源读取游戏图片

ForI=0To2

'不用PictureBox

SethBmp=LoadResPicture（IIf（MnuCheck

（1）.Checked,410,411）+I*10,vbResBitmap）

LethBmpDC（I）=CreateCompatibleDC（Me.hdc）

CallSelectObject（hBmpDC（I）,hBmp.Handle）

SethBmp=Nothing

EndSub

PublicSubGameStart（）'游戏开始

'NoMine=False

LetMe.Width=MLeft+（MWidth*16+8+GetMePixelWidth-Me.ScaleWidth）*Screen.TwipsPerPixelX'调整窗体宽度

LetMe.Height=MTop+（MHeight*16+8+GetMePixelHeight-Me.ScaleHeight）*Screen.TwipsPerPixelY'调整窗体高度270OR390'19/26'495/510

LetIsFirstHit=False'没有埋雷'没有处理第一个雷

LetIsGameWin=False'没有赢

LetIsGameOver=False'没有输

LetTimer1.Enabled=False'定时器，需要鼠标激活

LetTime_Count=0'记时器清零

LetNowFace=4'CallCheckFace（4）

ReDimN（MWidth-1,MHeight-1）

LetShow_Count=MWidth*MHeight'倒计数字，剩余未揭开的格子

LetMine_Count=Mines'剩余未标记的地雷

CallForm_Paint

CallSetMines

EndSub

PrivateSubSetMines（）'OptionalByValXAsLong,OptionalByValYAsLong初始化地雷

DimIAsLong',JAsLong

DimAAsLong,BAsLong

DimKAsLong,LAsLong

CallMath.Randomize'初始化随机数生成器。

ForI=0ToMines-1

LetA=Int（MWidth*Rnd）'Int（（upperbound-lowerbound+1）*Rnd+lowerbound）

LetB=Int（MHeight*Rnd）

IfNotN（A,B）.IsMineThen'不能重复，不能是按下的位置'Not（A=XAndb=Y）And

'IfI=1Then

'IfNoMine=FalseThen

'LetA=X:

b=Y'第一个按下去总是雷--#

'EndIf

LetN（A,B）.IsMine=True

'统计每个格子周围的地雷数目

AddtionA,B,1

Else

LetI=I-1'再来

EndIf

NextI

'NoMine=False

'显示每个格子'作弊1

'DimJAsLong

'作弊2

'ForI=0To8

'ForJ=0To8

'IfN（I,J）.IsMineThen

'N（I,J）.State=1

''SetImageI,J,15-N（I,J）.Number

''N（I,J）.IsShow=True

'EndIf

'Next

EndSub

PrivateSubAddtion（ByValXAsLong,ByValYAsLong,ByValOneAsLong）

DimIAsLong,JAsLong

ForI=-1To1

ForJ=-1To1

IfInRange（X+I,Y+J）AndNot（I=0AndJ=0）Then'在地图的范围内

LetN（X+I,Y+J）.Number=N（X+I,Y+J）.Number+One

EndIf

EndSub

PrivateSubSetImage（ByValXAsLong,ByValYAsLong,OptionalByValImgIDAsLong）'雷区

'每个图片宽16，高16，ImgID=0~15

CallBitBlt（Me.hdc,MLeft/Screen.TwipsPerPixelX+X*BMP_GRID_WIDTH,MTop/Screen.TwipsPerPixelY+Y*BMP_GRID_HEIGHT,BMP_GRID_WIDTH,BMP_GRID_HEIGHT,hBmpDC（0）,0,ImgID*BMP_GRID_HEIGHT,vbSrcCopy）

EndSub

PrivateSubSetNumber（ByValXAsLong,ByValYAsLong,ByValNumIDAsLong,OptionalByValnWhatAsBoolean=True）'剩余地雷和时间

'每个数字宽13，高23，NumID=0~11

CallBitBlt（Me.hdc,X*BMP_NUM_WIDTH+IIf（nWhat,BMP_NUM_MINE_LEFT,GetMePixelWidth-BMP_NUM_TIME_RIGHT）,Y*BMP_NUM_HEIGHT+BMP_NUM_TOP,BMP_NUM_WIDTH,BMP_NUM_HEIGHT,hBmpDC

（1）,0,BMP_NUM_HEIGHT*NumID,vbSrcCopy）

EndSub

PrivateSubSetFace（OptionalByValFaceIDAsLong=4）'表情

'每个笑脸宽24，高24，NumID=0~4

CallBitBlt（Me.hdc,GetMePixelWidth/2-BMP_FACE_WIDTH/2-1,BMP_FACE_TOP,BMP_FACE_WIDTH,BMP_FACE_HEIGHT,hBmpDC

（2）,0,BMP_FACE_HEIGHT*FaceID,vbSrcCopy）

EndSub

PrivateFunctionInRange（ByValXAsLong,ByValYAsLong）AsBoolean'判断鼠标坐标在雷区（按每单位16像素）

'Debug.PrintX,Y

LetInRange=（X>=0AndX<=MWidth-1AndY>=0AndY<=MHeight-1）

EndFunction

PrivateFunctionOnFace（ByValXAsSingle,ByValYAsSingle）AsBoolean'判断鼠标坐标在表情上

DimCXAsLong,CYAsLong

DimphWidthAsLong

LetCX=CLng（X）:

LetCY=CLng（Y）

LetphWidth=GetMePixelWidth/2

LetOnFace=（CX>=phWidth-BMP_FACE_WIDTH/2AndCX<=phWidth+BMP_FACE_WIDTH/2AndCY>=BMP_FACE_TOPAndCY<=BMP_FACE_TOP+BMP_FACE_HEIGHT）

EndFunction

PrivateFunctionCalcX（ByValXAsSingle,ByValM1AsLong,ByValM2AsLong）AsLong'计算距离（X坐标）

DimCXAsLong

LetCX=CLng（X）

LetM1=M1/Screen.TwipsPerPixelX

LetCalcX=IIf（CX>=M1AndCX<=M2*BMP_GRID_WIDTH+M1,（CX-M1）\BMP_GRID_WIDTH,-1）

EndFunction

PrivateFunctionCalcY（ByValYAsSingle,ByValM1AsLong,ByValM2AsLong）AsLong'计算距离（X坐标）

DimCYAsLong

LetCY=CLng（Y）

LetM1=M1/Screen.TwipsPerPixelY

LetCalcY=IIf（CY>=M1AndCY<=M2*BMP_GRID_HEIGHT+M1,（CY-M1）\BMP_GRID_HEIGHT,-1）

EndFunction

'PrivateFunctionCalcXY（ByValXYAsSingle,ByValM1AsLong,ByValM2AsLong）AsLong'计算距离（坐标）

'DimCNAsLong

'LetCN=CLng（XY）*15

'LetCalcXY=IIf（CN>=M1AndCN<=M2*240+M1,（CN-M1）\240,-1）

'EndFunction

PrivateSubCheckFace（OptionalByValFaceIDAsLong=0）'绘制当前表情

IfFaceID<>0ThenLetNowFace=FaceID

CallSetFace（NowFace）

EndSub

'雷区的图

PrivateSubRefreshImage（）'重新绘制图片

'Me.Cls'清除原图

DimIAsLong,JAsLong

ForI=0ToMWidth-1

ForJ=0ToMHeight-1

WithN（I,J）

CallSetImage（I,J,IIf（.IsShow,IIf（.IsMine,3,15-.Number）,.State））

'If.IsShowThen

'If.IsMineThen

'SetImageI,J,3'踩雷的图片

'Else

'SetImageI,J,15-.Number'数字

'EndIf

'Else'If.State<>0Then

'SetImageI,J,.State'已标记的

'EndIf

EndWith

IfIsGameOverThenCallGameOver

EndSub

PrivateSubDrawMine_Count（）'绘制所剩地雷（液晶显示）计数器

DimIAsLong,JAsLong

LetJ=Mine_Count

IfJ>=0AndJ<=999Then'正

ForI=2To0Step-1

CallSetNumber（I,0,11-JMod10）

LetJ=J\10

ElseIfJ<0AndJ>=-99Then'负

CallSetNumber（0,0,0）

LetJ=-J'Abs（J）

ForI=2To1Step-1

CallSetNumber（I,0,11-JMod10）

LetJ=J\10

Else

ForI=0To2

CallSetNumber（I,0,1）

NextI

'CallSetNumber（0,0,1）

'CallSetNumber（1,0,1）

'CallSetNumber（2,0,1）

EndIf

EndSub

PrivateSubDrawTime_Count（）'时间统计0~999计时器

DimIAsLong,JAsLong

LetJ=Time_Count

IfJ>=0AndJ<=999Then

ForI=2To0Step-1

CallSetNumber（I,0,11-JMod10,False）

LetJ=J\10

Else'999

ForI=0To2

CallSetNumber（I,0,2,False）

NextI

'CallSetNumber（0,0,2,False）

'CallSetNumber（1,0,2,False）

'CallSetNumber（2,0,2,False）

EndIf

EndSub

PrivateSubGameWin（）

'已经赢了

'LetNowFace=1

CallCheckFace

（1）

LetMine_Count=0

CallDrawMine_Count

DimIAsLong,JAsLong

ForI=0ToMWidth-1

ForJ=0ToMHeight-1

IfN（I,J）.IsShow=FalseAndN（I,J）.IsMineThen

CallSetImage（I,J,1）'自动标记雷

LetN（I,J）.State=1

EndIf

IfNowLevel>=0AndNowLevel<3Then

IfTime_Count

FrmRecord.ShowvbModal

EndIf

EndSub

PrivateSubGameOver（）'游戏失败

DimIAsLong,JAsLong

'LetNowFace=2

CallCheckFace

（2）

ForI=0ToMWidth-1

ForJ=0ToMHeight-1

WithN（I,J）

If.IsMineThen

If.State<>1Then'12/28修正=0为<>1

CallSetImage（I,J,IIf（.IsShow,3,5））

'If.IsShowThen

'CallSetImage（I,J,3）'踩到的雷'12/2915:

09增加

'Else

'CallSetImage（I,J,5）'真正的雷

'EndIf

EndIf

Else

If.State=1ThenCallSetImage（I,J,4）'错误的

EndIf

EndWith

'CallSetImage（MouseDown.X,MouseDown.Y,3）'踩到的雷'12/2915:

09删除

EndSub

PrivateSubShowZero（ByValXAsLong,ByValYAsLong）'自动揭晓雷数为0的格子周围的格子

DimIAsLong,JAsLong

WithN（X,Y）

If.IsShow=FalseThen'还没有揭开

CallSetImage（X,Y,15）'先换图片

Let.IsShow=True

'遍历八方

ForI=-1To1

ForJ=-1To1

IfInRange（X+I,Y+J）Then'在地图的范围内

WithN（X+I,Y+J）

IfNot（.IsShow）And.State<>1Then'还没有揭开并且没有标记为雷就继续

If.Number=0Then'又是一个八方无雷的格子

CallShowZero（X+I,Y+J）'递归

Else

CallSetImage（X+I,Y+J,15-.Number）'显示八方的格子数字

Let.IsShow=True

EndIf

LetShow_Count=Show_Count-1

EndIf

EndWith

EndIf

EndWith

EndSub

PrivateSubN9SET（ByValXAsLong,ByValYAsLong,OptionalByValIsDownAsBoolean=True）'OrUp'鼠标双键同按的情况

DimIAsLong,JAsLong

ForI=-1To1

ForJ=-1To1

IfInRange（X+I,Y+J）T

展开阅读全文