Vb扫雷程序代码

《Vb扫雷程序代码》由会员分享，可在线阅读，更多相关《Vb扫雷程序代码（40页珍藏版）》请在装配图网上搜索。

1、wordPrivate objMine As New clsWinMinePrivate Sub Form_Load() Set objMine.frmDisplay = MeEnd SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 判断单击的是哪个区域 objMine.BeginHitTest Button, x, yEnd SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer,

2、x As Single, y As Single) 判断当鼠标左键按下的时候鼠标指针在哪个区域 objMine.TrackHitTest Button, x, yEnd SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 判断释放鼠标左键的时候鼠标指针在哪个区域 objMine.EndHitTest Button, x, yEnd SubPrivate Sub mnuBeginner_Click() mnuBeginner.Checked = True mnuInt

3、ermediate.Checked = False mnuExpert.Checked = False mnuCustom.Checked = False 初级模式 objMine.SetMineFieldDimension 8, 8, 10, False objMine.mblnNewGame = TrueEnd SubPrivate Sub mnuCustom_Click() mnuBeginner.Checked = False mnuIntermediate.Checked = False mnuExpert.Checked = False mnuCustom.Checked = Tr

4、ue 中级模式 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 frmCustomDlg 做好准备开始新游戏 objMine.mblnNew

5、Game = TrueEnd SubPrivate Sub mnuExit_Click() 调用terminate事件 Set objMine = Nothing 退出游戏 EndEnd SubPrivate Sub mnuExpert_Click() mnuBeginner.Checked = False mnuIntermediate.Checked = False mnuExpert.Checked = True mnuCustom.Checked = False 高级模式 objMine.SetMineFieldDimension 16, 30, 100, False objMine.

6、mblnNewGame = TrueEnd SubPrivate Sub mnuIntermediate_Click() mnuBeginner.Checked = False mnuIntermediate.Checked = True mnuExpert.Checked = False mnuCustom.Checked = False 自定义模式 objMine.SetMineFieldDimension 16, 16, 40, False objMine.mblnNewGame = TrueEnd SubPrivate Sub mnuNew_Click() 开始新游戏End SubOp

7、tion Explicit 判断左键是否按下Private Const LEFT_BUTTON As Byte = 1 标记没有地雷的区域Private Const NONE As Byte = 0 标记是否触雷Private Const MINE As Byte = 243 已经去除地雷的区域Private Const BEEN As Byte = 244 标记确定已经有地雷的区域Private Const FLAGGED As Byte = 2 标记可疑区域Private Const QUESTION As Byte = 1 最大、最小行列数Private Const MIN_MINES

8、As Byte = 10Private Const MAX_MINES As Byte = 99Private Const MIN_ROWS As Integer = 8Private Const MAX_ROWS As Integer = 24Private Const MIN_COLS As Integer = 8Private Const MAX_COLS As Integer = 36 宽Private Const mintButtonWidth As Byte = 16 高Private Const mintButtonHeight As Byte = 16 总地雷数Private

9、mbytNumMines As Byte 尚未标记的地雷数Private mbytCorrectHits As Byte 已经标记出的雷数包括错误的Private mbytTotalHits As Byte 不同等级游戏的总行列数Private mintRows As IntegerPrivate mintCols As IntegerPrivate mintRow As IntegerPrivate mintCol As Integer 标记是否开始新游戏Public mblnNewGame As Boolean 标记一个鼠标单击事件正在进展Private mblnHitTestBegun

10、As BooleanPrivate mfrmDisplay As FormPrivate mbytMineStatus() As BytePrivate mbytMarked() As BytePrivate mbytMineLocations() As BytePrivate mcolWrongLocations As New CollectionPublic Sub BeginHitTest(intButton As Integer, intX As Single, intY As Single) 如果当前游戏完毕如此开始新的游戏 If mblnNewGame Then NewGame E

11、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 如果该区

12、域已经去除干净，如此单击无效 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 =

13、 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 Case m

14、bytMarked(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 增加已标记地雷的

15、总数 mbytTotalHits = mbytTotalHits + 1 mfrmDisplay.lblMinesLeft = _ Mines Left : & mbytNumMines - mbytTotalHits 如果标记正确 If mbytMineStatus(intY, intX) = MINE Then mbytCorrectHits = mbytCorrectHits + 1 mbytMarked(intY, intX) = FLAGGED Else 如果标记错误 Dim objCoords As New clsCoords objCoords.mintX = intX objC

16、oords.mintY = intY mcolWrongLocations.Add objCoords mbytMarked(intY, intX) = _ mbytTotalHits - mbytCorrectHits + 2 End If 如果所有地雷都正确的标记出来 If mbytCorrectHits = mbytNumMines Then Msg = 太棒了！ & CRLF Msg = Msg & 你赢了！ & CRLF MsgBox Msg, vbInformation, WinMine 准备开始新游戏 mblnNewGame = True End If Case QUESTION

17、: 如果标记位置已做其他标记 mbytMarked(intY, intX) = NONE 显示区域不变 mfrmDisplay.PaintPicture _ mfrmDisplay.imgButton, mintCol, mintRow Case Else: mfrmDisplay.PaintPicture _ mfrmDisplay.imgQuestion, mintCol, mintRow 总数减1 mbytTotalHits = mbytTotalHits - 1 刷新 mfrmDisplay.lblMinesLeft = _ Mines Left : & mbytNumMines -

18、mbytTotalHits 如果当前标记区域有地雷 If mbytMineStatus(intY, intX) = MINE Then 总数减1 mbytCorrectHits = mbytCorrectHits - 1 Else 如果标记错误 mcolWrongLocations.Remove mbytMarked(intY, intX) - 2 Dim intXwm As Integer Dim intYwm As Integer Dim i As Integer For i = mbytMarked(intY, intX) - 2 _ intXwm = mcolWrongLocation

19、s(i).mintX intYwm = mcolWrongLocations(i).mintY mbytMarked(intYwm, intXwm) = _ mbytMarked(intYwm, intXwm) - 1 Next End If mbytMarked(intY, intX) = QUESTION End Select End IfEnd SubPublic Sub EndHitTest(intButton As Integer, intX As Single, intY As Single) If mblnHitTestBegun Then 重置标记 mblnHitTestBeg

20、un = False Else Exit Sub End If Dim 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 = mi

21、ntCol mintButtonWidth intY = mintRow 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

22、intXm As Integer Dim intYm As Integer Dim vntCoord As Variant Dim i As Integer For i = 0 To mbytNumMines - 1 intYm = mbytMineLocations(i, 0) intXm = mbytMineLocations(i, 1) If mbytMarked(intYm, intXm) = 0 And intY + r = 0 And intX + c mintCols If blnDy And blnDx Then If mbytMineStatus(intY + r, intX

23、 + c) MINE Then mbytMineStatus(intY + r, intX + c) = _ mbytMineStatus(intY + r, intX + c) + 1 End If End If Next Next NextEnd SubPublic Sub NewGame() 去除窗体 重置所有变量 mbytCorrectHits = 0 mbytTotalHits = 0 mintRow = -1 mintCol = -1 mblnNewGame = False mblnHitTestBegun = False Dim i As Integer mcolWrongLoc

24、ations.Remove 1 Next InitializeMineField mfrmDisplay.lblMinesLeft = Mines Left : & mbytNumMinesEnd 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

25、 intYStart As Integer Dim intPos As Integer Dim element 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 I

26、f Wend blnGoUp = True intXStart = intX intYStart = intY Do 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 intX = intX - 1 intY = intY - 1 blnGoRight = False blnGoUp

27、 = 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 = intX And intYStart = intY) Then Exit Do Else If blnGo

28、Up Then colX(intY).Add intX If mbytMineStatus(intY, intX + 1) = NONE Then If intY = 0 Then blnGoUp = FalseUP: intX = intX + 1 If (intXStart = intX And intYStart = intY) _ Then Exit Do While mbytMineStatus(intY, intX) = NONE If intX = mintCols - 1 Then GoTo RIGHT intX = intX + 1 If (intXStart = intX

29、And intYStart = intY) _ Then Exit Do Wend blnGoDown = True Else intY = intY - 1 If (intXStart = intX And intYStart = intY) _ Then Exit 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

30、 element In colX(intY) If element = intXStart Then colX(intY).Remove (intPos) Exit Do End If intPos = intPos + 1 Next End If Exit Do End If End If ElseIf blnGoRight Then If mbytMineStatus(intY + 1, intX) = NONE Then If intX = mintCols - 1 Then blnGoRight = FalseRIGHT: colX(intY).Add intX intY = intY

31、 + 1 If (intXStart = intX And intYStart = intY) _ Then Exit Do While mbytMineStatus(intY, intX) = NONE colX(intY).Add intX If intY = 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

32、 (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 Do End If End If Else blnGoRight = False blnGoDown = True colX(intY).Add

33、 intX intY = intY + 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 = FalseDOWN: intX = intX - 1 If (intXStart = intX And intYStart = intY) _ Then Exit Do While mbytMineStatus(intY, intX) = NONE If intX = 0 Then GoTo LFT intX = intX - 1 If (intXStart = intX And intYStart = intY) _