Vb扫雷程序代码.docx
《Vb扫雷程序代码.docx》由会员分享，可在线阅读，更多相关《Vb扫雷程序代码.docx（35页珍藏版）》请在冰豆网上搜索。
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（）
'清除窗体
升级会员 