module1.bas

本程序用JAVA程序实现了俄罗斯方块游戏的基本功能

Attribute VB_Name = "Module1"
Public Const SND_ASYNC = &H1
Public Const SND_NOSTOP = &H10
Global blnGrid(0 To 22, 0 To 11) As Boolean                '定义网格是否被占据的逻辑型数组
Global lngColor(0 To 22, 0 To 11) As Long                  '定义网格方块上的颜色
Global blnBlock(0 To 4, 0 To 3, 0 To 3, 0 To 3) As Boolean '定义5种方块4种方向逻辑型数组
Global rotateOption As Boolean                             '定义旋转方案变量
Global showNextBlock As Boolean                            '定义显示下一个与否
Global pressOption As Boolean                              '定义按键方案变量
Global fallGrid As Integer                                 '定义下落格数变量
Global fullNum As Integer                                  '格数被全部占满的行数变量
Global chkFull(22) As Boolean
Global highestScore As String * 8                          '历史最高分变量
Global nameOfPlayer As String * 16                         '最高分玩家姓名
Enum ColorOption                                           '定义颜色枚举变量
     RED = &HFF&
     YELLOW = &HFFFF&
     PINK = &HFF00FF
     GREEN = &HFF00&
     BLUE = &HFF0000
End Enum

Type Position
     X As Integer
     Y As Integer
End Type

Type Block
     blockType As Integer                                '定义方块类型变量
     blockDirection As Integer                           '定义方块方向变量
     blockPosition As Position                           '定义方块位置变量
     blockColor As ColorOption                           '定义方块颜色变量
End Type

Global currentBlock As Block
Global nextBlock As Block
Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
                      (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Sub defineBlock()
  Call blnBlockInit
  blnBlock(0, 0, 0, 3) = True: blnBlock(0, 0, 1, 3) = True
  blnBlock(0, 0, 2, 3) = True: blnBlock(0, 0, 3, 3) = True       '(1-a)
  blnBlock(0, 1, 0, 0) = True: blnBlock(0, 1, 0, 1) = True
  blnBlock(0, 1, 0, 2) = True: blnBlock(0, 1, 0, 3) = True       '(1-b)
  blnBlock(0, 2, 0, 3) = True: blnBlock(0, 2, 1, 3) = True
  blnBlock(0, 2, 2, 3) = True: blnBlock(0, 2, 3, 3) = True       '(1-c)
  blnBlock(0, 3, 0, 0) = True: blnBlock(0, 3, 0, 1) = True
  blnBlock(0, 3, 0, 2) = True: blnBlock(0, 3, 0, 3) = True       '(1-d)
  blnBlock(1, 0, 0, 3) = True: blnBlock(1, 0, 1, 1) = True
  blnBlock(1, 0, 1, 2) = True: blnBlock(1, 0, 1, 3) = True       '(2-a)
  blnBlock(1, 1, 0, 2) = True: blnBlock(1, 1, 1, 2) = True
  blnBlock(1, 1, 2, 2) = True: blnBlock(1, 1, 2, 3) = True       '(2-b)
  blnBlock(1, 2, 0, 1) = True: blnBlock(1, 2, 0, 2) = True
  blnBlock(1, 2, 0, 3) = True: blnBlock(1, 2, 1, 1) = True       '(2-c)
  blnBlock(1, 3, 0, 2) = True: blnBlock(1, 3, 0, 3) = True
  blnBlock(1, 3, 1, 3) = True: blnBlock(1, 3, 2, 3) = True       '(2-d)
  blnBlock(2, 0, 0, 1) = True: blnBlock(2, 0, 0, 2) = True
  blnBlock(2, 0, 0, 3) = True: blnBlock(2, 0, 1, 3) = True       '(3-a)
  blnBlock(2, 1, 0, 3) = True: blnBlock(2, 1, 1, 3) = True
  blnBlock(2, 1, 2, 2) = True: blnBlock(2, 1, 2, 3) = True       '(3-b)
  blnBlock(2, 2, 0, 1) = True: blnBlock(2, 2, 1, 1) = True
  blnBlock(2, 2, 1, 2) = True: blnBlock(2, 2, 1, 3) = True       '(3-c)
  blnBlock(2, 3, 0, 2) = True: blnBlock(2, 3, 0, 3) = True
  blnBlock(2, 3, 1, 2) = True: blnBlock(2, 3, 2, 2) = True       '(3-d)
  blnBlock(3, 0, 0, 1) = True: blnBlock(3, 0, 0, 2) = True
  blnBlock(3, 0, 0, 3) = True: blnBlock(3, 0, 1, 2) = True       '(4-a)
  blnBlock(3, 1, 0, 3) = True: blnBlock(3, 1, 1, 2) = True
  blnBlock(3, 1, 1, 3) = True: blnBlock(3, 1, 2, 3) = True       '(4-b)
  blnBlock(3, 2, 0, 2) = True: blnBlock(3, 2, 1, 1) = True
  blnBlock(3, 2, 1, 2) = True: blnBlock(3, 2, 1, 3) = True       '(4-c)
  blnBlock(3, 3, 0, 2) = True: blnBlock(3, 3, 1, 2) = True
  blnBlock(3, 3, 1, 3) = True: blnBlock(3, 3, 2, 2) = True       '(4-d)
  blnBlock(4, 0, 0, 2) = True: blnBlock(4, 0, 0, 3) = True
  blnBlock(4, 0, 1, 2) = True: blnBlock(4, 0, 1, 3) = True       '(5-a)
  blnBlock(4, 1, 0, 2) = True: blnBlock(4, 1, 0, 3) = True
  blnBlock(4, 1, 1, 2) = True: blnBlock(4, 1, 1, 3) = True       '(5-b)
  blnBlock(4, 2, 0, 2) = True: blnBlock(4, 2, 0, 3) = True
  blnBlock(4, 2, 1, 2) = True: blnBlock(4, 2, 1, 3) = True       '(5-c)
  blnBlock(4, 3, 0, 2) = True: blnBlock(4, 3, 0, 3) = True
  blnBlock(4, 3, 1, 2) = True: blnBlock(4, 3, 1, 3) = True       '(5-d)
End Sub

Sub GridInit()
  For i = 0 To 22
    For j = 0 To 11
       blnGrid(i, j) = False
       lngColor(i, j) = &H8000000F
    Next j
  Next i
  fullNum = 0                   '格数被全部占满的行数为零
  For i = 0 To 22
     chkFull(i) = False
  Next i
End Sub

Sub config()
  fallGrid = 1
  txtSpeed = 0: txtScore = 0
  rotateOption = True
  showNextBlock = True
  pressOption = True
  fallGrid = 1
End Sub

Sub blnBlockInit()
  For m = 0 To 4
   For n = 0 To 3
    For i = 0 To 3
     For j = 0 To 3
        blnBlock(m, n, i, j) = False
     Next j
    Next i
   Next n
  Next m
End Sub

Sub BlockInit()
  Randomize
  currentBlock.blockType = Int(Rnd * 5)
  currentBlock.blockDirection = Int(Rnd * 4)
  Select Case currentBlock.blockType
     Case 0
     currentBlock.blockColor = RED
     Case 1
     currentBlock.blockColor = YELLOW
     Case 2
     currentBlock.blockColor = PINK
     Case 3
     currentBlock.blockColor = GREEN
     Case 4
     currentBlock.blockColor = BLUE
  End Select
  currentBlock.blockPosition.X = Int(Rnd * 8)
  currentBlock.blockPosition.Y = 0
End Sub

Sub nextBlockGenerate()
  Randomize
  nextBlock.blockType = Int(Rnd * 5)
  nextBlock.blockDirection = Int(Rnd * 4)
  Select Case nextBlock.blockType
     Case 0
     nextBlock.blockColor = RED
     Case 1
     nextBlock.blockColor = YELLOW
     Case 2
     nextBlock.blockColor = PINK
     Case 3
     nextBlock.blockColor = GREEN
     Case 4
     nextBlock.blockColor = BLUE
  End Select
  nextBlock.blockPosition.X = 0
  nextBlock.blockPosition.Y = 0
End Sub