modtetrisutils.bas

一个俄罗斯方块游戏

Attribute VB_Name = "modTetrisUtils"
'*======================================================================================== <Description>
'* 模块: <modTetrisUtils>
'* 说明:
'*
'* 作者: <孙海文>   <北邮电信网络资源部>   <2002-7-27 14:05:05>
'*
'* 修改记录:
'* 作者     日期        说明              修改原因
'*======================================================================================== </Description>

Option Explicit

Public Type tagBlockPos
   Row As Long
   Col As Long
End Type

'* tagTetris contains the definition of a tetris
Public Type tagTetris
   BlockPos(3) As tagBlockPos  '* the pos of the blocks, subscript means (nBlockIndex)
   Matrix(0 To 3, 0 To 3) As Boolean   '* the matrix of the tetris, subscript means (nCol,nRow )
End Type

'* tagActiveTetris constains the information of a active tetris
Public Type tagActiveTetris
   Left As Long   '* the up left corner of the tetris
   Top As Long
   TetIndex As Long '* the tetris index
   Angle As Long  '* the angle of the tetris
End Type


Public g_tetrisdata(0 To 6, 0 To 3) As tagTetris '* subscript means(TetrisIndex, Angle)


'*======================================================================================== <Description>
'* <Init>
'* <说明>
'*    Initilize the g_tetrisdata, this initilize should be done before any tetris
'*    operation
'*
'* <参数>
'*    o None
'*
'* <返回>
'*    o None
'*
'* <作者>            <孙海文>   <北邮电信网络资源部>   <2002-7-27 14:38:24>
'* <修改记录>
'* 作者     日期        说明
'*======================================================================================== </Description>
Public Sub Init()
   Static bInited As Boolean
   If bInited Then
      Exit Sub
   End If
   bInited = True
   
   Dim sDat(0 To 6, 0 To 3) As String '*
   sDat(0, 0) = "□□□□　□□■□　□□□□　□□■□"
   sDat(0, 1) = "■■■■　□□■□　■■■■　□□■□"
   sDat(0, 2) = "□□□□　□□■□　□□□□　□□■□"
   sDat(0, 3) = "□□□□　□□■□　□□□□　□□■□"
   
   sDat(1, 0) = "□□□□　□□□□　□□□□　□□□□"
   sDat(1, 1) = "□■■□　□■■□　□■■□　□■■□"
   sDat(1, 2) = "□■■□　□■■□　□■■□　□■■□"
   sDat(1, 3) = "□□□□　□□□□　□□□□　□□□□"
   
   sDat(2, 0) = "□□□□　□■□□　□■□□　□■□□"
   sDat(2, 1) = "■■■□　□■■□　■■■□　■■□□"
   sDat(2, 2) = "□■□□　□■□□　□□□□　□■□□"
   sDat(2, 3) = "□□□□　□□□□　□□□□　□□□□"
   
   sDat(3, 0) = "□□□□　□□□□　□□□□　□□□□"
   sDat(3, 1) = "■■□□　□■□□　■■□□　□■□□"
   sDat(3, 2) = "□■■□　■■□□　□■■□　■■□□"
   sDat(3, 3) = "□□□□　■□□□　□□□□　■□□□"
   
   sDat(4, 0) = "□□□□　□□□□　□□□□　□□□□"
   sDat(4, 1) = "□■■□　■□□□　□■■□　■□□□"
   sDat(4, 2) = "■■□□　■■□□　■■□□　■■□□"
   sDat(4, 3) = "□□□□　□■□□　□□□□　□■□□"
   
   sDat(5, 0) = "□□□□　□■■□　□□□□　□■□□"
   sDat(5, 1) = "■■■□　□■□□　■□□□　□■□□"
   sDat(5, 2) = "□□■□　□■□□　■■■□　■■□□"
   sDat(5, 3) = "□□□□　□□□□　□□□□　□□□□"
                      
   sDat(6, 0) = "□□□□　□■□□　□□□□　■■□□"
   sDat(6, 1) = "■■■□　□■□□　□□■□　□■□□"
   sDat(6, 2) = "■□□□　□■■□　■■■□　□■□□"
   sDat(6, 3) = "□□□□　□□□□　□□□□　□□□□"
      
   '* Initilize the block matrix
   Dim nTetIndex As Long, nRow As Long, nAngle As Long, nCol As Long
   For nTetIndex = 0 To 6
      For nRow = 0 To 3
         Dim sTemp() As String
         sTemp = Split(sDat(nTetIndex, nRow), "　")
         For nAngle = 0 To 3
            For nCol = 0 To 3
               If Mid(sTemp(nAngle), nCol + 1, 1) = "■" Then
                  g_tetrisdata(nTetIndex, nAngle).Matrix(nCol, nRow) = True
               Else
                  g_tetrisdata(nTetIndex, nAngle).Matrix(nCol, nRow) = False
               End If
            Next nCol
         Next nAngle
      Next nRow
   Next nTetIndex

   '* intilize the block position array
   Dim nBlockIndex As Long
   For nTetIndex = 0 To 6
      For nAngle = 0 To 3
         nBlockIndex = 0
         For nRow = 0 To 3
            For nCol = 0 To 3
               If g_tetrisdata(nTetIndex, nAngle).Matrix(nCol, nRow) Then
                  With g_tetrisdata(nTetIndex, nAngle).BlockPos(nBlockIndex)
                     .Row = nRow
                     .Col = nCol
                  End With
                  nBlockIndex = nBlockIndex + 1
               End If
            Next nCol
         Next nRow
         Debug.Assert nBlockIndex = 4
      Next nAngle
   Next nTetIndex
End Sub


'*======================================================================================== <Description>
'* <CanPlaceTetris>
'* <说明>
'*    Test if a active tetris can place in the panel. A tetris can place in the panel,
'*    if all blocks in the tetris are in the range of the panel and will not overlap
'*    any existed block in the panel.
'*
'* <参数>
'*    o [IN] ActTetris  the active tetris to be placed
'*    o [IN] Panel   the tetris panel
'*
'* <返回>
'*    o True if the tetris can be placed
'*    o False if the tetris can not be placed
'*
'* <作者>            <孙海文>   <北邮电信网络资源部>   <2002-7-27 14:41:07>
'* <修改记录>
'* 作者     日期        说明
'*======================================================================================== </Description>
Public Function CanPlaceTetris(ByVal nTetIndex As Long, ByVal nAngle As Long, ByVal nLeft As Long, ByVal nTop As Long, Panel() As Byte) As Boolean
   Dim nPanelRowLB As Long, nPanelRowUB As Long '* the lower and upper bound of the Panel() array
   Dim nPanelColLB As Long, nPanelColUB As Long '* the lower and upper bound of the Panel() array
   nPanelRowLB = LBound(Panel, 2)
   nPanelRowUB = UBound(Panel, 2)
   nPanelColLB = LBound(Panel, 1)
   nPanelColUB = UBound(Panel, 1)

   Dim I As Long
   Dim nCol As Long, nRow As Long
   Dim bValid As Boolean

   bValid = True

   '* Test if the tetris can be place there
   For I = 0 To 3
      With g_tetrisdata(nTetIndex, nAngle).BlockPos(I)
         nCol = nLeft + .Col + nPanelColLB
         nRow = nTop + .Row + nPanelRowLB
      End With
      
      If nCol < nPanelColLB Or nCol > nPanelColUB Then
         bValid = False
      ElseIf nRow < nPanelRowLB Then
         '* valid, do nothing
      ElseIf nRow > nPanelRowUB Then
         bValid = False
      ElseIf Panel(nCol, nRow) <> 0 Then
         bValid = False
      End If

      If Not bValid Then
         CanPlaceTetris = False
         Exit Function
      End If
   Next

   CanPlaceTetris = True
End Function


'*======================================================================================== <Description>
'* <PlaceTetris>
'* <说明>
'*    place the tetris in the panel
'*    NOTE: the tetris can be partly or full out of the panel
'*
'* <参数>
'*    o [IN] ActTetris
'*    o [IN] Panel
'*
'* <返回>
'*    o None
'*
'* <作者>            <孙海文>   <北邮电信网络资源部>   <2002-7-27 14:51:09>
'* <修改记录>
'* 作者     日期        说明
'*======================================================================================== </Description>
Public Sub PlaceTetris(ByVal nTetIndex As Long, ByVal nAngle As Long, ByVal nLeft As Long, ByVal nTop As Long, Panel() As Byte)
   Dim nPanelRowLB As Long, nPanelRowUB As Long '* the lower and upper bound of the Panel() array
   Dim nPanelColLB As Long, nPanelColUB As Long '* the lower and upper bound of the Panel() array
   nPanelRowLB = LBound(Panel, 2)
   nPanelRowUB = UBound(Panel, 2)
   nPanelColLB = LBound(Panel, 1)
   nPanelColUB = UBound(Panel, 1)

   Dim I As Long
   Dim nCol As Long, nRow As Long, nX As Long, nY As Long

   For I = 0 To 3
      With g_tetrisdata(nTetIndex, nAngle).BlockPos(I)
         nCol = nLeft + .Col + nPanelColLB
         nRow = nTop + .Row + nPanelRowLB
      End With

      If nRow >= nPanelRowLB And nRow <= nPanelRowUB And nCol >= nPanelColLB And nCol <= nPanelColUB Then
         Panel(nCol, nRow) = nTetIndex + 1
      End If
   Next
End Sub


Public Sub RemoveTetris(ByVal nTetIndex As Long, ByVal nAngle As Long, ByVal nLeft As Long, ByVal nTop As Long, Panel() As Byte)
   Dim nPanelRowLB As Long, nPanelRowUB As Long '* the lower and upper bound of the Panel() array
   Dim nPanelColLB As Long, nPanelColUB As Long '* the lower and upper bound of the Panel() array
   nPanelRowLB = LBound(Panel, 2)
   nPanelRowUB = UBound(Panel, 2)
   nPanelColLB = LBound(Panel, 1)
   nPanelColUB = UBound(Panel, 1)

   Dim I As Long
   Dim nCol As Long, nRow As Long, nX As Long, nY As Long

   For I = 0 To 3
      With g_tetrisdata(nTetIndex, nAngle).BlockPos(I)
         nCol = nLeft + .Col + nPanelColLB
         nRow = nTop + .Row + nPanelRowLB
      End With

      If nRow >= nPanelRowLB And nRow <= nPanelRowUB And nCol >= nPanelColLB And nCol <= nPanelColUB Then
         Panel(nCol, nRow) = 0
      End If
   Next
End Sub