Loading...
墨滴

Donsole

2021/06/10  阅读:30  主题:前端之巅同款

【Excel VBA】Excel也能玩糖果消消乐?

Excel也能玩糖果消消乐?

可以告诉你:当然可以!

Excel使用VBA编程,不仅可以轻松搭建糖果消消乐游戏,还有高分记录,撤销上一步等功能。不信,往下看:

打开Excel表格加载游戏,Go!

捕获7
捕获7

关于游戏

捕获2
捕获2

开始游戏

捕获1
捕获1

游戏进行中

捕获5
捕获5

撤销上一步

捕获4
捕获4

分数排名

捕获6
捕获6

界面编辑状态

捕获8
捕获8

快来下载Excel文件,一探究竟吧!

欢迎关注:Python编程与Office办公自动化

部分代码:

Private Sub m_BuildBallBoard()

    Dim intRow As Integer
    Dim intCol As Integer
    Dim strName As String
    Dim labTemp As MSForms.Label
    Dim strUseName As String
    Dim sngTop As Single
    Dim sngLeft As Single
    
    sngTop = labBackdrop.Top
    For intRow = 0 To CUBEGAME_HEIGHT
        sngLeft = 0
        For intCol = 0 To CUBEGAME_WIDTH
            strName = CUBEGAME_PREFIX & Format$(intRow, "00") & Format$(intCol, "00")
            Set labTemp = Controls(strName)
            labTemp.Move sngLeft, sngTop, CUBEGAME_MARKERSIZE, CUBEGAME_MARKERSIZE
            strUseName = "labCube" & m_intBoard(intRow, intCol)
            With Controls(strUseName)
                labTemp.Tag = strUseName
                labTemp.Picture = .Picture
                labTemp.BackColor = QBColor(15)
                labTemp.BackStyle = .BackStyle
                labTemp.SpecialEffect = .SpecialEffect
            End With
            sngLeft = sngLeft + CUBEGAME_MARKERSIZE
        Next
        sngTop = sngTop + CUBEGAME_MARKERSIZE
    Next
    For intRow = 0 To CUBEGAME_HEIGHT
        For intCol = 0 To CUBEGAME_WIDTH
            strName = "labMarker_" & Format$(intRow, "00") & Format$(intCol, "00")
            Controls(strName).Visible = True
        Next
    Next
    labMask.ZOrder
End Sub

'--------------------------------------------------------

Private Function m_GameOver() As Boolean
'
' 测试剩余的可消糖果数测算下一步移动
' 如果还可以移动则继续
' 如果不能移动则 game over
'
    Dim intRow As Integer
    Dim intCol As Integer
    Dim lngCount As Long
    
    For intCol = 0 To CUBEGAME_WIDTH
        For intRow = CUBEGAME_HEIGHT To 0 Step -1
            If m_intBoard(intRow, intCol) > 0 Then
                lngCount = 0
                m_Connection intRow, intCol, m_intBoard(intRow, intCol), lngCount
                If lngCount > 1 Then
                    m_GameOver = False
                    Exit Function
                End If
                m_ResetSelection
            End If
        Next
    Next
    m_GameOver = True
    
End Function

Donsole

2021/06/10  阅读:30  主题:前端之巅同款

作者介绍

Donsole