Vb扫雷程序代码.docx
- 文档编号:5378829
- 上传时间:2023-05-08
- 格式:DOCX
- 页数:35
- 大小:20.16KB
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+r blnDx=intX+c>=0AndintX+c IfblnDyAndblnDxThen IfmbytMineStatus(intY+r,intX+c)<>MINEThen mbytMineStatus(intY+r,intX+c)=_ mbytMineStatus(intY+r,intX+c)+1 EndIf EndIf Next Next Next EndSub PublicSubNewGame() '清除窗体
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- Vb 扫雷 程序代码