Excel版俄罗斯方块

本文介绍了一位作者使用Excel VBA实现的俄罗斯方块游戏,包括游戏初始化、方块移动、下落、形态变化等功能,并提供了相关的API函数声明和游戏逻辑代码。代码虽然效率不高,但可以正常运行,适合初学者了解如何在Excel环境中拓展应用程序。
摘要由CSDN通过智能技术生成

废话少说。现在我把一年多前的在Excel环境下用vba实现的俄罗斯方块的代码提供给大家,算是对拓展office应用的一个总结。由于程序是在去年写的,现在看来思路都有点不记得了,而且语句都不太高效。但我又懒得修改了,毕竟这个是可以正确运行的。大家参考我另外两篇相关的文章,试着做吧。

还是新建一个宏,键入下面代码。

Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long   '首先是API函数调用的声明。

 

Type pos_
    row As Long
    col As Long
End Type

Type obj
    pos As pos_
    stat As Long
    typ As Long
    color As Long
End Type  '基本对象数据结构的定义

Public cur_obj As obj
Public prv_obj As obj
Public nex_obj As obj
Public objs_array(27, 3) As pos_

Dim startpos As pos_
Dim nextpos As pos_

Global score As Long '分数
Public score_level As Long
Dim level As Long

Public gaming As Boolean
Public pulse As Boolean

Public interval As Long   '定时器时间间隙
Public timerset As Long   '定时器

Public top As Long   '记录方块堆积的最高层所在行

Public Const mosttop As Long = 5   '游戏区域的顶,当方块堆积到这里游戏结束
Public Const left As Long = 5   '游戏区域左边界
Public Const right As Long = 22   '游戏区域左边界
Public Const middle As Long = (left + right) / 2   '游戏区域中线,用以定位
Public Const bottom As Long = 25   '游戏区域底

Sub main()
    gaming = False

    If Worksheets.Count < 2 Then
        ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
    Else
        Worksheets(Worksheets.Count).Select
    End If
    Load UserForm1
    UserForm1.Show
    End Sub

Function game_initial()
    '游戏初始化函数
    startpos.row = mosttop
    startpos.col = middle
    nextpos.row = mosttop
    nextpos.col = right + 8
    top = bottom - 1
    score = 0
    Range(Cells(mosttop + 1, left), Cells(bottom - 1, left)).Interior.ColorIndex = 1
    Range(Cells(mosttop + 1, right), Cells(bottom - 1, right)).Interior.ColorIndex = 1
    Range(Cells(bottom, left), Cells(bottom, right)).Interior.ColorIndex = 1
    Range(Cells(bottom, left), Cells(bottom, right)) = " "
   
    If Not gaming Then
   
    Cells.ColumnWidth = 1
    Cells.RowHeight = 10
       '初始化各形状的方块,我都忘了哪个对应哪种类型了
    objs_array(0, 0).row = -1
    objs_array(0, 0).col = -1
    objs_array(0, 1).row = 0
    objs_array(0, 1).col = -1
    objs_array(0, 2).row = 0
    objs_array(0, 2).col = 0
    objs_array(0, 3).row = 1
    objs_array(0, 3).col = 0
   
    objs_array(1, 0).row = 0
    objs_array(1, 0).col = 0
    objs_array(1, 1).row = 0
    objs_array(1, 1).col = 1
    objs_array(1, 2).row = 1
    objs_array(1, 2).col = 0
    objs_array(1, 3).row = 1
    objs_array(1, 3).col = -1
   
    objs_array(2, 0).row = -1
    objs_array(2, 0).col = -1
    objs_array(2, 1).row = 0
    objs_array(2, 1).col = -1
    objs_array(2, 2).row = 0
    objs_array(2, 2).col = 0
    objs_array(2, 3).row = 1
    objs_array(2, 3).col = 0
   
    objs_array(3, 0).row = 0
    objs_array(3, 0).col = 0
    objs_array(3, 1).row = 0
    objs_array(3, 1).col = 1
    objs_array(3, 2).row = 1
    objs_array(3, 2).col = 0
    objs_array(3, 3).row = 1
    objs_array(3, 3).col = -1
   
    ''type 2
    objs_array(4, 0).row = -1
    objs_array(4, 0).col = 0
    objs_array(4, 1).row = 0
    objs_array(4, 1).col = 0
    objs_array(4, 2).row = 0
    objs_array(4, 2).col = -1
    objs_array(4, 3).row = 1
    objs_array(4, 3).col = -1
   
    objs_array(5, 0).row = 0
    objs_array(5, 0).col = -1
    objs_array(5, 1).row = 0
    objs_array(5, 1).col = 0
    objs_array(5, 2).row = 1
    objs_array(5, 2).col = 0
    objs_array(5, 3).row = 1
    objs_array(5, 3).col = 1
   
    objs_array(6, 0).row = -1
    objs_array(6, 0).col = 0
    objs_array(6, 1).row = 0
    objs_array(6, 1).col = 0
    objs_array(6, 2).row = 0
    objs_array(6, 2).col = -1
    objs_array(6, 3).row =

评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值