Vb扫雷程序代码.docx
《Vb扫雷程序代码.docx》由会员分享，可在线阅读，更多相关《Vb扫雷程序代码.docx（26页珍藏版）》请在冰豆网上搜索。
Vb扫雷程序代码
PrivateobjMineAsNewclsWinMine
PrivateSubForm_Load（）
SetobjMine、frmDisplay=Me
EndSub
PrivateSubForm_MouseDown（ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle）
'判断单击的就是哪个区域
objMine、BeginHitTestButton,x,y
EndSub
PrivateSubForm_MouseMove（ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle）
'判断当鼠标左键按下的时候鼠标指针在哪个区域
objMine、TrackHitTestButton,x,y
EndSub
PrivateSubForm_MouseUp（ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle）
'判断释放鼠标左键的时候鼠标指针在哪个区域
objMine、EndHitTestButton,x,y
EndSub
PrivateSubmnuBeginner_Click（）
mnuBeginner、Checked=True
mnuIntermediate、Checked=False
mnuExpert、Checked=False
mnuCustom、Checked=False
'初级模式
objMine、SetMineFieldDimension8,8,10,False
objMine、mblnNewGame=True
EndSub
PrivateSubmnuCustom_Click（）
mnuBeginner、Checked=False
mnuIntermediate、Checked=False
mnuExpert、Checked=False
mnuCustom、Checked=True
'中级模式
objMine、GetMineFieldDimensionsfrmCustomDlg
frmCustomDlg、Show1
'如果按ESC键,则退出
IffrmCustomDlg、mblnEscapeThenExitSub
objMine、SetMineFieldDimensionVal（frmCustomDlg、txtRows）,Val（frmCustomDlg、txtColumns）,Val（frmCustomDlg、txtMines）,True
'卸载隐藏的对话框
UnloadfrmCustomDlg
'做好准备开始新游戏
objMine、mblnNewGame=True
EndSub
PrivateSubmnuExit_Click（）
'调用terminate事件
SetobjMine=Nothing
'退出游戏
End
EndSub
PrivateSubmnuExpert_Click（）
mnuBeginner、Checked=False
mnuIntermediate、Checked=False
mnuExpert、Checked=True
mnuCustom、Checked=False
'高级模式
objMine、SetMineFieldDimension16,30,100,False
objMine、mblnNewGame=True
EndSub
PrivateSubmnuIntermediate_Click（）
mnuBeginner、Checked=False
mnuIntermediate、Checked=True
mnuExpert、Checked=False
mnuCustom、Checked=False
'自定义模式
objMine、SetMineFieldDimension16,16,40,False
objMine、mblnNewGame=True
EndSub
PrivateSubmnuNew_Click（）
'开始新游戏
objMine、NewGame
EndSub
OptionExplicit
'判断左键就是否按下
PrivateConstLEFT_BUTTONAsByte=1
'标记没有地雷的区域
PrivateConstNONEAsByte=0
'标记就是否触雷
PrivateConstMINEAsByte=243
'已经清除地雷的区域
PrivateConstBEENAsByte=244
'标记确定已经有地雷的区域
PrivateConstFLAGGEDAsByte=2
'标记可疑区域
PrivateConstQUESTIONAsByte=1
'最大、最小行列数
PrivateConstMIN_MINESAsByte=10
PrivateConstMAX_MINESAsByte=99
PrivateConstMIN_ROWSAsInteger=8
PrivateConstMAX_ROWSAsInteger=24
PrivateConstMIN_COLSAsInteger=8
PrivateConstMAX_COLSAsInteger=36
'宽
PrivateConstmintButtonWidthAsByte=16
'高
PrivateConstmintButtonHeightAsByte=16
'总地雷数
PrivatembytNumMinesAsByte
'尚未标记的地雷数
PrivatembytCorrectHitsAsByte
'已经标记出的雷数（包括错误的）
PrivatembytTotalHitsAsByte
'不同等级游戏的总行列数
PrivatemintRowsAsInteger
PrivatemintColsAsInteger
PrivatemintRowAsInteger
PrivatemintColAsInteger
'标记就是否开始新游戏
PublicmblnNewGameAsBoolean
'标记一个鼠标单击事件正在进行
PrivatemblnHitTestBegunAsBoolean
PrivatemfrmDisplayAsForm
PrivatembytMineStatus（）AsByte
PrivatembytMarked（）AsByte
PrivatembytMineLocations（）AsByte
PrivatemcolWrongLocationsAsNewCollection
PublicSubBeginHitTest（intButtonAsInteger,intXAsSingle,intYAsSingle）
'如果当前游戏结束则开始新的游戏
IfmblnNewGameThen
NewGame
EndIf
mblnHitTestBegun=True
'根据位图计算栅格大小
intX=Int（intX/mintButtonWidth）
intY=Int（intY/mintButtonHeight）
'退出
IfintX>=mintCols_
OrintY>=mintRows_
OrintX<0_
OrintY<0Then
ExitSub
EndIf
mintCol=intX*mintButtonWidth
mintRow=intY*mintButtonHeight
IfmbytMineStatus（intY,intX）>=BEENThenExitSub
DimblnLeftDownAsBoolean
blnLeftDown=（intButtonAndLEFT_BUTTON）>0
'如果左键单击
IfblnLeftDownThen
'如果该区域已经清除干净,则单击无效
IfmbytMarked（intY,intX）>=FLAGGEDThenExitSub
IfmbytMarked（intY,intX）=QUESTIONThen
mfrmDisplay、imgPressed、Visible=False
mfrmDisplay、imgQsPressed、Visible=False
mfrmDisplay、imgQsPressed、Left=mintCol
mfrmDisplay、imgQsPressed、Top=mintRow
mfrmDisplay、imgQsPressed、Visible=True
Else
mfrmDisplay、imgQsPressed、Visible=False
mfrmDisplay、imgPressed、Visible=False
mfrmDisplay、imgPressed、Left=mintCol
mfrmDisplay、imgPressed、Top=mintRow
mfrmDisplay、imgPressed、Visible=True
EndIf
Else
'如果右键单击
DimMsgAsString
DimCRLFAsString
CRLF=Chr$（13）&Chr$（10）
SelectCasembytMarked（intY,intX）
CaseNONE:
IfmbytTotalHits=mbytNumMinesThen
Msg="不能标记更多的雷！
"&CRLF
Msg=Msg&"一个或多个雷标记错误。
"&CRLF
Msg=Msg&"单击鼠标右键取消某些雷的标记。
"
MsgBoxMsg,vbCritical,"WinMine:
Error!
"
ExitSub
EndIf
'如果不做标记,则显示一个准备标记的图标
mfrmDisplay、PaintPicturemfrmDisplay、imgFlag,mintCol,mintRow
'增加已标记地雷的总数
mbytTotalHits=mbytTotalHits+1
mfrmDisplay、lblMinesLeft=_
"MinesLeft:
"&mbytNumMines-mbytTotalHits
'如果标记正确
IfmbytMineStatus（intY,intX）=MINEThen
mbytCorrectHits=mbytCorrectHits+1
mbytMarked（intY,intX）=FLAGGED
Else'如果标记错误
DimobjCoordsAsNewclsCoords
objCoords、mintX=intX
objCoords、mintY=intY
mcolWrongLocations、AddobjCoords
mbytMarked（intY,intX）=_
mbytTotalHits-mbytCorrectHits+2
EndIf
'如果所有地雷都正确的标记出来
IfmbytCorrectHits=mbytNumMinesThen
Msg="太棒了！
"&CRLF
Msg=Msg&"您赢了！
"&CRLF
MsgBoxMsg,vbInformation,"WinMine"
'准备开始新游戏
mblnNewGame=True
EndIf
CaseQUESTION:
'如果标记位置已做其她标记
mbytMarked（intY,intX）=NONE
'显示区域不变
mfrmDisplay、PaintPicture_
mfrmDisplay、imgButton,mintCol,mintRow
CaseElse:
mfrmDisplay、PaintPicture_
mfrmDisplay、imgQuestion,mintCol,mintRow
'总数减1
mbytTotalHits=mbytTotalHits-1
'刷新
mfrmDisplay、lblMinesLeft=_
"MinesLeft:
"&mbytNumMines-mbytTotalHits
'如果当前标记区域有地雷
IfmbytMineStatus（intY,intX）=MINEThen
'总数减1
mbytCorrectHits=mbytCorrectHits-1
Else'如果标记错误
mcolWrongLocations、RemovembytMarked（intY,intX）-2
DimintXwmAsInteger
DimintYwmAsInteger
DimiAsInteger
Fori=mbytMarked（intY,intX）-2_
TomcolWrongLocations、Count
intXwm=mcolWrongLocations（i）、mintX
intYwm=mcolWrongLocations（i）、mintY
mbytMarked（intYwm,intXwm）=_
mbytMarked（intYwm,intXwm）-1
Next
EndIf
mbytMarked（intY,intX）=QUESTION
EndSelect
EndIf
EndSub
PublicSubEndHitTest（intButtonAsInteger,intXAsSingle,intYAsSingle）
IfmblnHitTestBegunThen
'重置标记
mblnHitTestBegun=False
Else
ExitSub
EndIf
DimblnLeftDownAsBoolean
blnLeftDown=（intButtonAndLEFT_BUTTON）>0
'如果鼠标左键按下
IfblnLeftDownThen
'计算行列数
intX=Int（intX/mintButtonWidth）
intY=Int（intY/mintButtonHeight）
IfintX>=mintColsOrintY>=mintRows_
OrintX<0OrintY<0Then
ExitSub
EndIf
IfmbytMarked（intY,intX）>=FLAGGEDThenExitSub
intX=mintCol\mintButtonWidth
intY=mintRow\mintButtonHeight
IfmbytMarked（intY,intX）=QUESTIONThen
mfrmDisplay、imgQsPressed、Visible=False
Else
mfrmDisplay、imgPressed、Visible=False
EndIf
SelectCasembytMineStatus（intY,intX）
CaseIs>=BEEN:
ExitSub
CaseNONE:
OpenBlanksintX,intY
CaseMINE:
DimintXmAsInteger
DimintYmAsInteger
DimvntCoordAsVariant
DimiAsInteger
Fori=0TombytNumMines-1
intYm=mbytMineLocations（i,0）
intXm=mbytMineLocations（i,1）
IfmbytMarked（intYm,intXm）mfrmDisplay、PaintPicturemfrmDisplay、imgMine,_
intXm*mintButtonWidth,intYm*mintButtonHeight
EndIf
Next
mfrmDisplay、PaintPicture_
mfrmDisplay、imgBlown,mintCol,mintRow
ForEachvntCoordInmcolWrongLocations
intYm=vntCoord、mintY
intXm=vntCoord、mintX
mfrmDisplay、PaintPicture_
mfrmDisplay、imgWrongMine,_
intXm*mintButtonWidth,_
intYm*mintButtonHeight
Next
'准备开始新游戏
mblnNewGame=True
DimCRLFAsString
CRLF=Chr$（13）&Chr$（10）
MsgBox"您输了！
",vbExclamation,"WinMine"
CaseElse:
mfrmDisplay、PaintPicture_
mfrmDisplay、imgPressed,mintCol,mintRow
mfrmDisplay、CurrentX=mintCol
mfrmDisplay、CurrentY=mintRow
mfrmDisplay、ForeColor=QBColor（mbytMineStatus（intY,intX））
mfrmDisplay、PrintmbytMineStatus（intY,intX）
'标记已经清除
mbytMineStatus（intY,intX）=_
mbytMineStatus（intY,intX）+BEEN
EndSelect
EndIf
EndSub
PublicPropertySetfrmDisplay（frmDisplayAsForm）
SetmfrmDisplay=frmDisplay
mfrmDisplay、FontBold=True
'为了适应游戏级别,改变窗体大小
ResizeDisplay
EndProperty
'获取当前雷区的大小
PublicSubGetMineFieldDimensions（frmDialogAsForm）
frmDialog、txtRows=mintRows
frmDialog、txtColumns=mintCols
frmDialog、txtMines=mbytNumMines
frmDialog、txtRows、SelLength=Len（frmDialog、txtRows）
frmDialog、txtColumns、SelLength=Len（frmDialog、txtColumns）
frmDialog、txtMines、SelLength=Len（frmDialog、txtMines）
EndSub
'初始化雷区
PrivateSubInitializeMineField（）
ReDimmbytMineStatus（mintRows-1,mintCols-1）
ReDimmbytMarked（mintRows-1,mintCols-1）
ReDimmbytMineLocations（mbytNumMines-1,1）
Randomize
DimiAsInteger
DimrAsInteger
DimcAsInteger
Fori=0TombytNumMines-1
DimintXAsInteger
DimintYAsInteger
intX=Int（Rnd*mintCols）
intY=Int（Rnd*mintRows）
WhilembytMineStatus（intY,intX）=MINE
intX=Int（Rnd*mintCols）
intY=Int（Rnd*mintRows）
Wend
mbytMineStatus（intY,intX）=MINE
mbytMineLocations（i,0）=intY
mbytMineLocations（i,1）=intX
Forr=-1To1
Forc=-1To1
DimblnDxAsBoolean
DimblnDyAsBoolean
blnDy=intY+r>=0AndintY+rblnDx=intX+c>=0AndintX+cIfblnDyAndblnDxThen
IfmbytMineStatus（intY+r,intX+c）<>MINEThen
mbytMineStatus（intY+r,intX+c）=_
mbytMineStatus（intY+r,intX+c）+1
EndIf
EndIf
Next
Next
Next
EndSub
PublicSubNewGame（）
'清除窗体
mfrmDisplay、Cls
'重置所有变量
mbytCorrectHits=0
mbytTotalHits=0
mintRow=-1
mintCol=-1
mblnNewGame=False
mblnHitTestBegun=False
DimiAsInteger
Fori=
升级会员 