【小游戏】在Excel中玩扫雷V1.1

Option ExplicitPublic Const GRID_SIZE As Integer = 20Public Const MINE_COUNT As Integer = 50Public Mines() As BooleanPublic Revealed() As BooleanPublic Marked() As BooleanPublic GameOver As BooleanPublic FirstClick As BooleanSub InitializeGame(Optional safeRow As Integer = 0, Optional safeCol As Integer = 0)    Dim i As Integer, j As Integer, count As Integer    GameOver = False    FirstClick = False    ' 验证安全坐标有效性    If safeRow < 1 Or safeRow > GRID_SIZE Then safeRow = 0    If safeCol < 1 Or safeCol > GRID_SIZE Then safeCol = 0    ' 初始化数组    ReDim Mines(1 To GRID_SIZE, 1 To GRID_SIZE)    ReDim Revealed(1 To GRID_SIZE, 1 To GRID_SIZE)    ReDim Marked(1 To GRID_SIZE, 1 To GRID_SIZE)    ' 清空游戏区域    With Sheet1        .Range("A1:T20").Clear        .Range("A1:T20").Interior.Color = RGB(192, 192, 192)        .Range("A1:T20").Font.Color = RGB(0, 0, 0)        .Range("A1:T20").Borders.LineStyle = xlContinuous    End With    ' 随机生成地雷（避开安全坐标）    Randomize    Do While count < MINE_COUNT        i = Int(GRID_SIZE * Rnd) + 1        j = Int(GRID_SIZE * Rnd) + 1        ' 确保坐标有效且不在安全位置        If i >= 1 And i <= GRID_SIZE And _           j >= 1 And j <= GRID_SIZE And _           Not (i = safeRow And j = safeCol) Then            If Not Mines(i, j) Then                Mines(i, j) = True                count = count + 1            End If        End If    LoopEnd SubSub RevealCell(row As Integer, col As Integer)    If row < 1 Or row > GRID_SIZE Or col < 1 Or col > GRID_SIZE Then Exit Sub    If Revealed(row, col) Or Marked(row, col) Then Exit Sub    Revealed(row, col) = True    Dim count As Integer: count = CountAdjacentMines(row, col)    With Sheet1.Cells(row, col)        .Interior.Color = RGB(255, 255, 255)        If count > 0 Then            .Value = count            Select Case count                Case 1: .Font.Color = RGB(0, 0, 255)                Case 2: .Font.Color = RGB(0, 128, 0)                Case 3: .Font.Color = RGB(255, 0, 0)                Case 4: .Font.Color = RGB(0, 0, 128)                Case Else: .Font.Color = RGB(128, 0, 128)            End Select        Else            ' 递归揭开周围单元格            Dim i As Integer, j As Integer            For i = row - 1 To row + 1                For j = col - 1 To col + 1                    If i <> row Or j <> col Then                        RevealCell i, j                    End If                Next j            Next i        End If    End WithEnd SubFunction CountAdjacentMines(row As Integer, col As Integer) As Integer    Dim i As Integer, j As Integer, count As Integer    For i = row - 1 To row + 1        For j = col - 1 To col + 1            If i >= 1 And i <= GRID_SIZE And j >= 1 And j <= GRID_SIZE Then                If Mines(i, j) Then count = count + 1            End If        Next j    Next i    CountAdjacentMines = countEnd FunctionSub GameLost()    GameOver = True    Dim i As Integer, j As Integer    For i = 1 To GRID_SIZE        For j = 1 To GRID_SIZE            If Mines(i, j) Then                Sheet1.Cells(i, j).Interior.Color = RGB(255, 0, 0)                Sheet1.Cells(i, j).Value = " X"            End If        Next j    Next i    MsgBox "游戏结束！你输了！", vbCritical    InitializeGameEnd SubFunction CheckWin() As Boolean    Dim i As Integer, j As Integer    For i = 1 To GRID_SIZE        For j = 1 To GRID_SIZE            If Not Mines(i, j) And Not Revealed(i, j) Then Exit Function        Next j    Next i    CheckWin = True    MsgBox "恭喜！你赢了！", vbInformation    InitializeGameEnd FunctionSub RestartGame()    InitializeGameEnd Sub

Option Explicit' API 函数声明：检测鼠标右键是否被按下（兼容 32/64 位 Excel）' 如果编译出错，请尝试删除 "PtrSafe" 关键字Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As IntegerPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)    ' 检测右键是否被按下，如果是则忽略此次选中变化（由右键引起）    If GetAsyncKeyState(vbKeyRButton) And &H8000 Then        Exit Sub    End If    If GameOver Then Exit Sub    If Intersect(Target, Me.Range("A1:T20")) Is Nothing Then Exit Sub    Application.EnableEvents = False    Dim row As Integer: row = Target.row    Dim col As Integer: col = Target.Column    ' 加强边界检查    If row < 1 Or row > GRID_SIZE Or col < 1 Or col > GRID_SIZE Then        Application.EnableEvents = True        Exit Sub    End If    ' 首次点击保护    If Not FirstClick Then        ' 确保Mines数组已初始化        If Not IsArrayInitialized(Mines) Then            InitializeGame        End If        ' 如果首次点击是地雷，重新生成布局        If Mines(row, col) Then            InitializeGame row, col        End If        FirstClick = True    End If    If Not Revealed(row, col) And Not Marked(row, col) Then        If Mines(row, col) Then            GameLost        Else            RevealCell row, col            CheckWin        End If    End If    ' 安全取消选中    On Error Resume Next    Me.Range("A11").Select    Application.EnableEvents = TrueEnd Sub' ========== 鼠标右键标记地雷 ==========Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)    ' 阻止默认右键菜单弹出    Cancel = True    ' 仅当游戏已开始且未结束时，才执行标记/取消标记    If FirstClick And Not GameOver Then        ' 仅处理游戏区域内的单元格        If Intersect(Target, Me.Range("A1:T20")) Is Nothing Then Exit Sub        Dim row As Integer: row = Target.Row        Dim col As Integer: col = Target.Column        ' 边界检查        If row < 1 Or row > GRID_SIZE Or col < 1 Or col > GRID_SIZE Then Exit Sub        ' 已揭开的格子不能标记        If Revealed(row, col) Then Exit Sub        ' 切换标记状态（禁止事件触发，避免循环）        Application.EnableEvents = False        If Marked(row, col) Then            ' 取消标记：恢复灰色背景，清空内容            Marked(row, col) = False            With Me.Cells(row, col)                .ClearContents                .Interior.Color = RGB(192, 192, 192)            End With        Else            ' 添加标记：显示“P”并设为黄色背景            Marked(row, col) = True            With Me.Cells(row, col)                .Value = "P"          ' 可替换为旗帜符号如 "⚑"                .Interior.Color = RGB(255, 255, 0)   ' 黄色背景                .Font.Color = RGB(0, 0, 0)            End With        End If        Application.EnableEvents = True    End IfEnd Sub' ========== 右键标记结束 ==========' 辅助函数：检查数组初始化状态Private Function IsArrayInitialized(arr As Variant) As Boolean    On Error Resume Next    IsArrayInitialized = IsArray(arr) And _                        Not IsError(LBound(arr, 1)) And _                        UBound(arr, 1) >= LBound(arr, 1)End Function