没有合适的资源?快使用搜索试试~ 我知道了~
Vb扫雷程序代码.doc
1.该资源内容由用户上传,如若侵权请联系客服进行举报
2.虚拟产品一经售出概不退款(资源遇到问题,请及时私信上传者)
2.虚拟产品一经售出概不退款(资源遇到问题,请及时私信上传者)
版权申诉
0 下载量 65 浏览量
2021-10-08
22:01:10
上传
评论
收藏 82KB DOC 举报
温馨提示
试读
23页
Vb扫雷程序代码.doc
资源推荐
资源详情
资源评论
- .
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 As 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.Checked = 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 = False
mnuCustom.Checked = True
' 中级模式
objMine.GetMineFieldDimensions frmCustomDlg
frmCustomDlg.Show 1
- .word.zl.
- .
' 如果按 ESC 键,那么退出
If frmCustomDlg.mblnEscape Then Exit Sub
objMine.SetMineFieldDimension Val(frmCustomDlg.txtRows),
Val(frmCustomDlg.txtColumns), Val(frmCustomDlg.txtMines), True
' 卸载隐藏的对话框
Unload frmCustomDlg
' 做好准备开场新游戏
objMine.mblnNewGame = True
End Sub
Private Sub mnuExit_Click()
' 调用 terminate 事件
Set objMine = Nothing
' 退出游戏
End
End Sub
Private Sub mnuExpert_Click()
mnuBeginner.Checked = False
mnuIntermediate.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
mnuCustom.Checked = False
' 自定义模式
objMine.SetMineFieldDimension 16, 16, 40, False
objMine.mblnNewGame = True
End Sub
Private Sub mnuNew_Click()
' 开场新游戏
objMine.NewGame
End Sub
- .word.zl.
- .
Option 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 As Byte = 10
Private Const MAX_MINES As Byte = 99
Private Const MIN_ROWS As Integer = 8
Private Const MAX_ROWS As Integer = 24
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 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
- .word.zl.
- .
' 标记是否开场新游戏
Public mblnNewGame As Boolean
' 标记一个鼠标单击事件正在进展
Private mblnHitTestBegun As Boolean
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
End If
mblnHitTestBegun = True
' 根据位图计算栅格大小
intX = Int(intX / mintButtonWidth)
intY = Int(intY / mintButtonHeight)
' 退出
If intX >= mintCols _
Or intY >= mintRows _
Or intX < 0 _
Or intY < 0 Then
Exit Sub
End If
mintCol = intX * mintButtonWidth
mintRow = intY * mintButtonHeight
If mbytMineStatus(intY, intX) >= BEEN Then Exit Sub
Dim blnLeftDown As Boolean
blnLeftDown = (intButton And LEFT_BUTTON) > 0
- .word.zl.
- .
' 如果左键单击
If blnLeftDown Then
' 如果该区域已经去除干净,那么单击无效
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 = 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 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
' 增加已标记地雷的总数
- .word.zl.
剩余22页未读,继续阅读
资源评论
wdqsv88
- 粉丝: 3
- 资源: 13万+
下载权益
C知道特权
VIP文章
课程特权
开通VIP
上传资源 快速赚钱
- 我的内容管理 展开
- 我的资源 快来上传第一个资源
- 我的收益 登录查看自己的收益
- 我的积分 登录查看自己的积分
- 我的C币 登录后查看C币余额
- 我的收藏
- 我的下载
- 下载帮助
安全验证
文档复制为VIP权益,开通VIP直接复制
信息提交成功