Excel也能玩糖果消消乐?
可以告诉你:当然可以!
Excel使用VBA编程,不仅可以轻松搭建糖果消消乐游戏,还有高分记录,撤销上一步等功能。不信,往下看:
打开Excel表格加载游戏,Go!捕获7
关于游戏
捕获2
开始游戏
捕获1
游戏进行中
捕获5
撤销上一步
捕获4
分数排名
捕获6
界面编辑状态
捕获8
快来下载Excel文件,一探究竟吧!
链接:https://pan.baidu.com/s/14xFs9L0s1n1p4ldixqc5jQ
提取码:9oq0
欢迎关注: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
Copyright © 2024 妖气游戏网 www.17u1u.com All Rights Reserved