《2022年Vb扫雷程序代码.pdf》由会员分享，可在线阅读，更多相关《2022年Vb扫雷程序代码.pdf（18页珍藏版）》请在taowenge.com淘文阁网|工程机械CAD图纸|机械工程制图|CAD装配图下载|SolidWorks_CaTia_CAD_UG_PROE_设计图分享下载上搜索。
1、Vb 扫雷程序代码Private objMine As New clsWinMine Private Sub Form_Load() Set objMine、frmDisplay = Me End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 判断单击的就是哪个区域objMine 、BeginHitTest Button, x, y End Sub Private Sub Form_MouseMove(Button As Integer, Shift A
2、s Integer, x As Single, y As Single) 判断当鼠标左键按下的时候鼠标指针在哪个区域objMine 、TrackHitTest Button, x, y End Sub Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 判断释放鼠标左键的时候鼠标指针在哪个区域objMine 、EndHitTest Button, x, y End Sub Private Sub mnuBeginner_Click() mnuBeginner 、Check
3、ed = True mnuIntermediate 、Checked = False mnuExpert 、Checked = False mnuCustom、Checked = False 初级模式objMine 、SetMineFieldDimension 8, 8, 10, False objMine 、mblnNewGame = True End Sub Private Sub mnuCustom_Click() mnuBeginner 、Checked = False mnuIntermediate 、Checked = False mnuExpert 、Checked = Fals
4、e mnuCustom、Checked = True 中级模式objMine 、GetMineFieldDimensions frmCustomDlg frmCustomDlg、Show 1 如果按 ESC键,则退出If frmCustomDlg 、mblnEscape Then Exit Sub objMine 、 SetMineFieldDimension Val(frmCustomDlg 、 txtRows), Val(frmCustomDlg 、txtColumns), Val(frmCustomDlg 、txtMines), True 卸载隐藏的对话框Unload frmCustom
5、Dlg 做好准备开始新游戏objMine 、mblnNewGame = True End Sub Private Sub mnuExit_Click() 调用 terminate 事件精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -第 1 页，共 18 页 - - - - - - - - - - Vb 扫雷程序代码Set objMine = Nothing 退出游戏End End Sub Private Sub mnuExpert_Click() mnuBeginner 、Checked = False mn
6、uIntermediate 、Checked = False mnuExpert 、Checked = True mnuCustom、Checked = False 高级模式objMine 、SetMineFieldDimension 16, 30, 100, False objMine 、mblnNewGame = True End Sub Private Sub mnuIntermediate_Click() mnuBeginner 、Checked = False mnuIntermediate 、Checked = True mnuExpert 、Checked = False mnu
7、Custom、Checked = False 自定义模式objMine 、SetMineFieldDimension 16, 16, 40, False objMine 、mblnNewGame = True End Sub Private Sub mnuNew_Click() 开始新游戏objMine 、NewGame End Sub Option Explicit 判断左键就是否按下Private Const LEFT_BUTTON As Byte = 1 标记没有地雷的区域Private Const NONE As Byte = 0 标记就是否触雷Private Const MINE A
8、s Byte = 243 已经清除地雷的区域Private Const BEEN As Byte = 244 标记确定已经有地雷的区域Private Const FLAGGED As Byte = 2 标记可疑区域Private Const QUESTION As Byte = 1 最大、最小行列数Private Const MIN_MINES As Byte = 10 Private Const MAX_MINES As Byte = 99 Private Const MIN_ROWS As Integer = 8 Private Const MAX_ROWS As Integer = 24
9、 精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -第 2 页，共 18 页 - - - - - - - - - - Vb 扫雷程序代码Private Const MIN_COLS As Integer = 8 Private Const MAX_COLS As Integer = 36 宽Private Const mintButtonWidth As Byte = 16 高Private Const mintButtonHeight As Byte = 16 总地雷数Private mbytNumMines
10、 As Byte 尚未标记的地雷数Private mbytCorrectHits As Byte 已经标记出的雷数(包括错误的 ) Private mbytTotalHits As Byte 不同等级游戏的总行列数Private mintRows As Integer Private mintCols As Integer Private mintRow As Integer Private mintCol As Integer 标记就是否开始新游戏Public mblnNewGame As Boolean 标记一个鼠标单击事件正在进行Private mblnHitTestBegun As B
11、oolean Private mfrmDisplay As Form Private mbytMineStatus() As Byte Private mbytMarked() As Byte Private mbytMineLocations() As Byte Private mcolWrongLocations As New Collection Public Sub BeginHitTest(intButton As Integer, intX As Single, intY As Single) 如果当前游戏结束则开始新的游戏If mblnNewGame Then NewGame E
12、nd If mblnHitTestBegun = True 根据位图计算栅格大小intX = Int(intX / mintButtonWidth) intY = Int(intY / mintButtonHeight) 退出If intX = mintCols _ Or intY = mintRows _ Or intX 0 _ Or intY = BEEN Then Exit Sub Dim blnLeftDown As Boolean blnLeftDown = (intButton And LEFT_BUTTON) 0 如果左键单击If blnLeftDown Then 如果该区域已经
13、清除干净,则单击无效If mbytMarked(intY , intX) = FLAGGED Then Exit Sub If mbytMarked(intY , intX) = QUESTION Then mfrmDisplay 、imgPressed、Visible = False mfrmDisplay 、imgQsPressed、Visible = False mfrmDisplay 、imgQsPressed、Left = mintCol mfrmDisplay 、imgQsPressed、Top = mintRow mfrmDisplay 、imgQsPressed、Visible
14、 = True Else mfrmDisplay 、imgQsPressed、Visible = False mfrmDisplay 、imgPressed、Visible = False mfrmDisplay 、imgPressed、Left = mintCol mfrmDisplay 、imgPressed、Top = mintRow mfrmDisplay 、imgPressed、Visible = True End If Else 如果右键单击Dim Msg As String Dim CRLF As String CRLF = Chr$(13) & Chr$(10) Select
15、Case mbytMarked(intY, intX) Case NONE: If mbytTotalHits = mbytNumMines Then Msg = 不能标记更多的雷！ & CRLF Msg = Msg & 一个或多个雷标记错误。 & CRLF Msg = Msg & 单击鼠标右键取消某些雷的标记。 MsgBox Msg, vbCritical, WinMine: Error! Exit Sub End If 如果不做标记,则显示一个准备标记的图标mfrmDisplay 、 PaintPicture mfrmDisplay 、 imgFlag, mintCol, mintRow
16、增加已标记地雷的总数mbytTotalHits = mbytTotalHits + 1 mfrmDisplay 、lblMinesLeft = _ Mines Left : & mbytNumMines - mbytTotalHits 如果标记正确If mbytMineStatus(intY , intX) = MINE Then mbytCorrectHits = mbytCorrectHits + 1 精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -第 4 页，共 18 页 - - - - - - - -
17、 - - Vb 扫雷程序代码mbytMarked(intY , intX) = FLAGGED Else 如果标记错误Dim objCoords As New clsCoords objCoords、 mintX = intX objCoords、 mintY = intY mcolWrongLocations、 Add objCoords mbytMarked(intY , intX) = _ mbytTotalHits - mbytCorrectHits + 2 End If 如果所有地雷都正确的标记出来If mbytCorrectHits = mbytNumMines Then Msg
18、= 太棒了！ & CRLF Msg = Msg & 您赢了！ & CRLF MsgBox Msg, vbInformation, WinMine 准备开始新游戏mblnNewGame = True End If Case QUESTION: 如果标记位置已做其她标记mbytMarked(intY , intX) = NONE 显示区域不变mfrmDisplay 、PaintPicture _ mfrmDisplay 、imgButton, mintCol, mintRow Case Else: mfrmDisplay 、PaintPicture _ mfrmDisplay 、imgQuesti
19、on, mintCol, mintRow 总数减 1 mbytTotalHits = mbytTotalHits - 1 刷新mfrmDisplay 、lblMinesLeft = _ Mines Left : & mbytNumMines - mbytTotalHits 如果当前标记区域有地雷If mbytMineStatus(intY , intX) = MINE Then 总数减 1 mbytCorrectHits = mbytCorrectHits - 1 Else 如果标记错误mcolWrongLocations、Remove mbytMarked(intY , intX) - 2
20、Dim intXwm As Integer Dim intYwm As Integer Dim i As Integer For i = mbytMarked(intY, intX) - 2 _ To mcolWrongLocations、Count intXwm = mcolWrongLocations(i) 、mintX intYwm = mcolWrongLocations(i) 、mintY mbytMarked(intYwm, intXwm) = _ 精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -
21、第 5 页，共 18 页 - - - - - - - - - - Vb 扫雷程序代码mbytMarked(intYwm, intXwm) - 1 Next End If mbytMarked(intY , intX) = QUESTION End Select End If End Sub Public Sub EndHitTest(intButton As Integer, intX As Single, intY As Single) If mblnHitTestBegun Then 重置标记mblnHitTestBegun = False Else Exit Sub End If Dim
22、 blnLeftDown As Boolean blnLeftDown = (intButton And LEFT_BUTTON) 0 如果鼠标左键按下If blnLeftDown Then 计算行列数intX = Int(intX / mintButtonWidth) intY = Int(intY / mintButtonHeight) If intX = mintCols Or intY = mintRows _ Or intX 0 Or intY = FLAGGED Then Exit Sub intX = mintCol mintButtonWidth intY = mintRow
23、mintButtonHeight If mbytMarked(intY , intX) = QUESTION Then mfrmDisplay 、imgQsPressed、Visible = False Else mfrmDisplay 、imgPressed、Visible = False End If Select Case mbytMineStatus(intY, intX) Case Is = BEEN: Exit Sub Case NONE: OpenBlanks intX, intY Case MINE: Dim intXm As Integer Dim intYm As Inte
24、ger Dim vntCoord As Variant Dim i As Integer For i = 0 To mbytNumMines - 1 精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -第 6 页，共 18 页 - - - - - - - - - - Vb 扫雷程序代码intYm = mbytMineLocations(i, 0) intXm = mbytMineLocations(i, 1) If mbytMarked(intYm, intXm) = 0 And intY + r = 0 And
25、 intX + c mintCols If blnDy And blnDx Then If mbytMineStatus(intY + r, intX + c) MINE Then mbytMineStatus(intY + r, intX + c) = _ mbytMineStatus(intY + r, intX + c) + 1 End If End If Next Next Next End Sub Public Sub NewGame() 精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -第 8 页，
26、共 18 页 - - - - - - - - - - Vb 扫雷程序代码 清除窗体mfrmDisplay、 Cls 重置所有变量mbytCorrectHits = 0 mbytTotalHits = 0 mintRow = -1 mintCol = -1 mblnNewGame = False mblnHitTestBegun = False Dim i As Integer For i = 1 To mcolWrongLocations、Count mcolWrongLocations 、Remove 1 Next InitializeMineField mfrmDisplay、 lblMi
27、nesLeft = Mines Left : & mbytNumMines End Sub 打开雷区Private Sub OpenBlanks(ByVal intX As Single, ByVal intY As Single) Dim blnGoUp As Boolean Dim blnGoRight As Boolean Dim blnGoDown As Boolean Dim blnGoLeft As Boolean Dim intXStart As Integer Dim intYStart As Integer Dim intPos As Integer Dim element
28、As Variant Dim y As Integer Dim x As Integer Dim i As Integer Dim colX() As New Collection ReDim colX(mintRows - 1) While mbytMineStatus(intY , intX) = NONE intX = intX - 1 If intX 0 Then intX = 0 intXStart = intX intYStart = intY GoTo LFT End If Wend blnGoUp = True intXStart = intX intYStart = intY
29、 Do 精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -第 9 页，共 18 页 - - - - - - - - - - Vb 扫雷程序代码If mbytMineStatus(intY , intX) = NONE Then If blnGoUp Then intX = intX - 1 intY = intY + 1 colX(intY)、Remove (colX(intY)、Count) blnGoUp = False blnGoLeft = True ElseIf blnGoRight Then int
30、X = intX - 1 intY = intY - 1 blnGoRight = False blnGoUp = True ElseIf blnGoDown Then intX = intX + 1 intY = intY - 1 colX(intY)、Remove (colX(intY)、Count) blnGoDown = False blnGoRight = True ElseIf blnGoLeft Then intX = intX + 1 intY = intY + 1 blnGoLeft = False blnGoDown = True End If If (intXStart
31、= intX And intYStart = intY) Then Exit Do Else If blnGoUp Then colX(intY)、Add intX If mbytMineStatus(intY , intX + 1) = NONE Then If intY = 0 Then blnGoUp = False UP: intX = intX + 1 If (intXStart = intX And intYStart = intY) _ Then Exit Do While mbytMineStatus(intY , intX) = NONE If intX = mintCols
32、 - 1 Then GoTo RIGHT intX = intX + 1 If (intXStart = intX And intYStart = intY) _ Then Exit Do Wend blnGoDown = True Else intY = intY - 1 If (intXStart = intX And intYStart = intY) _ 精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -第 10 页，共 18 页 - - - - - - - - - - Vb 扫雷程序代码Then Ex
33、it Do End If Else blnGoUp = False blnGoRight = True intX = intX + 1 If (intXStart = intX And intYStart = intY) Then If colX(intY)、 Count Mod 2 0 Then intPos = 1 For Each element In colX(intY) If element = intXStart Then colX(intY)、 Remove (intPos) Exit Do End If intPos = intPos + 1 Next End If Exit
34、Do End If End If ElseIf blnGoRight Then If mbytMineStatus(intY + 1, intX) = NONE Then If intX = mintCols - 1 Then blnGoRight = False RIGHT: colX(intY)、Add intX intY = intY + 1 If (intXStart = intX And intYStart = intY) _ Then Exit Do While mbytMineStatus(intY , intX) = NONE colX(intY)、Add intX If in
35、tY = mintRows - 1 Then GoTo DOWN intY = intY + 1 If (intXStart = intX And intYStart = intY) _ Then Exit Do Wend colX(intY)、 Add intX blnGoLeft = True Else intX = intX + 1 If (intXStart = intX And intYStart = intY) Then If colX(intY)、Count Mod 2 0 Then intPos = 1 For Each element In colX(intY) If ele
36、ment = intXStart Then 精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -第 11 页，共 18 页 - - - - - - - - - - Vb 扫雷程序代码colX(intY)、Remove (intPos) Exit Do End If intPos = intPos + 1 Next End If Exit Do End If End If Else blnGoRight = False blnGoDown = True colX(intY)、Add intX intY = intY
37、 + 1 If (intXStart = intX And intYStart = intY) _ Then Exit Do End If ElseIf blnGoDown Then colX(intY)、Add intX If mbytMineStatus(intY , intX - 1) = NONE Then If intY = mintRows - 1 Then blnGoDown = False DOWN: intX = intX - 1 If (intXStart = intX And intYStart = intY) _ Then Exit Do While mbytMineS
38、tatus(intY , intX) = NONE If intX = 0 Then GoTo LFT intX = intX - 1 If (intXStart = intX And intYStart = intY) _ Then Exit Do Wend blnGoUp = True Else intY = intY + 1 If (intXStart = intX And intYStart = intY) _ Then Exit Do End If Else blnGoDown = False blnGoLeft = True intX = intX - 1 If (intXStar
39、t = intX And intYStart = intY) _ Then Exit Do End If 精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -第 12 页，共 18 页 - - - - - - - - - - Vb 扫雷程序代码ElseIf blnGoLeft Then If mbytMineStatus(intY - 1, intX) = NONE Then If intX = 0 Then blnGoLeft = False LFT: colX(intY)、Add intX If intY =
40、 0 Then GoTo UP intY = intY - 1 If (intXStart = intX And intYStart = intY) _ Then Exit Do While mbytMineStatus(intY , intX) = NONE colX(intY)、Add intX If intY = 0 Then GoTo UP intY = intY - 1 If (intXStart = intX And intYStart = intY) _ Then Exit Do Wend colX(intY)、 Add intX blnGoRight = True Else i
41、ntX = intX - 1 If (intXStart = intX And intYStart = intY) _ Then Exit Do End If Else blnGoLeft = False blnGoUp = True colX(intY)、Add intX intY = intY - 1 If (intXStart = intX And intYStart = intY) _ Then Exit Do End If End If End If Loop For y = 0 To mintRows - 1 If colX(y)、Count 0 Then For x = 1 To
42、 colX(y) 、Count Dim intXValue As Integer intXValue = colX(y)(x) If intXValue = 10 Then intXValue = intXValue + 55 End If 精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -第 13 页，共 18 页 - - - - - - - - - - Vb 扫雷程序代码mfrmDisplay、 lstSortedX、AddItem Chr$(intXValue) Next For x = 0 To mfr
43、mDisplay、lstSortedX、 ListCount - 1 Step 2 Dim intR1 As Integer Dim intC1 As Integer Dim intColStart As Integer Dim intColEnd As Integer Dim intDx As Integer Dim intWidth As Integer intR1 = y * mintButtonHeight intColStart = Asc(mfrmDisplay 、lstSortedX、List(x) If intColStart = 65 Then intColStart = i
44、ntColStart - 55 End If intColEnd = Asc(mfrmDisplay、lstSortedX、List(x + 1) If intColEnd = 65 Then intColEnd = intColEnd - 55 End If intC1 = intColStart * mintButtonWidth intDx = intColEnd - intColStart + 1 intWidth = intDx * mintButtonWidth mfrmDisplay、 PaintPicture mfrmDisplay 、imgOpenBlocks, _ intC
45、1, intR1, , , 0, 0, intWidth, mintButtonHeight For i = 0 To intDx - 1 If mbytMarked(y, intColStart + i) NONE Then If mbytMarked(y, intColStart + i) = QUESTION Then mfrmDisplay 、PaintPicture mfrmDisplay 、imgQuestion, _ intC1 + i * mintButtonWidth, intR1 Else mfrmDisplay 、PaintPicture mfrmDisplay 、img
46、Flag, _ intC1 + i * mintButtonWidth, intR1 End If ElseIf mbytMineStatus(y, intColStart + i) NONE Then mfrmDisplay 、CurrentX = intC1 + i * mintButtonWidth mfrmDisplay 、CurrentY = intR1 If mbytMineStatus(y, intColStart + i) = BEEN Then mfrmDisplay 、ForeColor = _ QBColor(mbytMineStatus(y, intColStart +
47、 i) - BEEN) mfrmDisplay 、Print _ mbytMineStatus(y, intColStart + i) - BEEN 精品资料 - - - 欢迎下载 - - - - - - - - - - - 欢迎下载 名师归纳 - - - - - - - - - -第 14 页，共 18 页 - - - - - - - - - - Vb 扫雷程序代码ElseIf mbytMineStatus(y, intColStart + i) = MINE Then mfrmDisplay 、PaintPicture _ mfrmDisplay 、imgButton, _ intC1 +
48、 i * mintButtonWidth, intR1 Else mfrmDisplay 、ForeColor = _ QBColor(mbytMineStatus(y, intColStart + i) mfrmDisplay 、Print mbytMineStatus(y, intColStart + i) mbytMineStatus(y, intColStart + i) = _ mbytMineStatus(y, intColStart + i) + BEEN End If End If Next Next mfrmDisplay 、lstSortedX、Clear End If N
49、ext End Sub 改变游戏级别Private Sub ResizeDisplay() mfrmDisplay、 ScaleMode = 1 mfrmDisplay、 Width = mfrmDisplay 、Width - _ mfrmDisplay 、ScaleWidth + _ mintCols * mintButtonWidth * _ Screen、TwipsPerPixelX mfrmDisplay、 Height = mfrmDisplay 、Height - _ mfrmDisplay 、ScaleHeight + _ mintRows * mintButtonHeight
50、 * _ Screen、TwipsPerPixelY + _ mfrmDisplay 、lblMinesLeft 、Height mfrmDisplay、 lblMinesLeft 、 Left = 0 mfrmDisplay、 lblMinesLeft 、 Top = _ mfrmDisplay 、ScaleHeight - _ mfrmDisplay 、lblMinesLeft 、Height mfrmDisplay、 lblMinesLeft 、 Width = _ mfrmDisplay 、ScaleWidth mfrmDisplay、 lblMinesLeft = _ Mines L