【VBA】用excel玩游戏，俄罗斯方块

提起excel第一印象就是办公，其实还可以用它来玩游戏！

经典俄罗斯方块奉上！

'By@yaxi_liu
'本文作者

看看游戏效果：

全局代码传送门：

'键盘事件代码，By@yaxi_liu
#If VBA7 And Win64 Then
  Private Declare PtrSafe Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
#Else
  Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
#End If
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim keycode(0 To 255) As Byte
    GetKeyboardState keycode(0)
    If keycode(38) > 127 Then   '上
        Call RotateObject
    ElseIf keycode(39) > 127 Then  '右
        Call MoveObject(1)
    ElseIf keycode(40) > 127 Then '下
        Call MoveObject(0)
    ElseIf keycode(37) > 127 Then '左
        Call MoveObject(-1)
    End If
End Sub

模块代码传送门：

Option Explicit

Dim MySheet As Worksheet
Dim iCenterRow As Integer   '方块中心行
Dim iCenterCol As Integer   '方块中心列
Dim ColorArr()              '7种颜色
Dim ShapeArr()              '7种方块
Dim iColorIndex As Integer  '颜色索引
Dim MyBlock(4, 2) As Integer    '每个方框的坐标数组，会随着方块的移动而变化
Dim bIsObjectEnd As Boolean     '本个方块是否下降到最低点
Dim iScore As Integer       '分数

'移动对象 By@yaxi_liu
Public Sub MoveObject(ByVal dir As Integer)
    Call MoveBlock(iCenterRow, iCenterCol, MyBlock, ColorArr(iColorIndex), dir)
End Sub
'旋转对象 By@yaxi_liu
Public Sub RotateObject()
    Call RotateBlock(iCenterRow, iCenterCol, MyBlock, ColorArr(iColorIndex))
End Sub

Sub Start()
    Call Init
    
'    iCenterRow = 5
'    iCenterCol = 6
'    iColorIndex = 4
'    Dim i As Integer
'    For i = 0 To 3
'        MyBlock(i, 0) = ShapeArr(iColorIndex)(i)(0)
'        MyBlock(i, 1) = ShapeAr