form1.frm

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

      Next i
   Next j
End Sub
Sub clrNextBlockZone()
   For j = 0 To 3
      For i = 0 To 3
        Picture2.Line (22 * i + 5, 22 * j + 5)-(22 * i + 21, 22 * j + 21), &H8000000F, BF
      Next i
   Next j
End Sub

Sub fallBlock()
'抹除上一个时刻方块
   Call eraseBlock
'纵坐标加1，检测碰撞
   currentBlock.blockPosition.Y = currentBlock.blockPosition.Y + 1
   If isBlockFilled = True Then
      currentBlock.blockPosition.Y = currentBlock.blockPosition.Y - 1
      Call drawBlock
      Call chkGameOver
      sndPlaySound App.Path & "\online.wav", SND_ASYNC
      Call autoRedrawAll
      Call resumeBlock
      Exit Sub
   End If
'重画方块
  Call drawBlock
'判断方块是否到达游戏区底部
  If isBlockGetBottom = True Then
     sndPlaySound App.Path & "\online.wav", SND_ASYNC
     Call autoRedrawAll
     Call resumeBlock
  End If
End Sub

Sub moveBlockLeft()
'判断方块是否超过左边界
   If isBlockLeftOut = True Then Exit Sub
'抹除移动前的方块
   Call eraseBlock
'横坐标减1，检测碰撞
   currentBlock.blockPosition.X = currentBlock.blockPosition.X - 1
   If isBlockFilled = True Then
      currentBlock.blockPosition.X = currentBlock.blockPosition.X + 1
   End If
'重画方块
   Call drawBlock
End Sub

Sub moveBlockRight()
'判断方块是否超过右边界
   If isBlockRightOut = True Then Exit Sub
'抹除移动前的方块
   Call eraseBlock
'横坐标加1，检测碰撞
   currentBlock.blockPosition.X = currentBlock.blockPosition.X + 1
   If isBlockFilled = True Then
      currentBlock.blockPosition.X = currentBlock.blockPosition.X - 1
   End If
'重画方块
   Call drawBlock
End Sub

Sub moveBlockDown()
 '抹除移动前的方块
   Call eraseBlock
'纵坐标加1，检测碰撞
   currentBlock.blockPosition.Y = currentBlock.blockPosition.Y + 1
   If isBlockFilled = True Then
      currentBlock.blockPosition.Y = currentBlock.blockPosition.Y - 1
      Call drawBlock
      Call chkGameOver
      sndPlaySound App.Path & "\online.wav", SND_ASYNC
      Call autoRedrawAll
      Call resumeBlock
      Exit Sub
   End If
'重画方块
   Call drawBlock
'判断方块是否到达游戏区底部
  If isBlockGetBottom = True Then
     sndPlaySound App.Path & "\online.wav", SND_ASYNC
     Call autoRedrawAll
     Call resumeBlock
  End If
End Sub

Sub rotateBlock()
If stopBlockRotate = True Then Exit Sub
'抹除移动前的方块
  Call eraseBlock
'根据旋转方案旋转
  If rotateOption = True Then
     If currentBlock.blockDirection < 3 Then
        currentBlock.blockDirection = currentBlock.blockDirection + 1
     Else
        currentBlock.blockDirection = 0
     End If
  Else
     If currentBlock.blockDirection > 0 Then
        currentBlock.blockDirection = currentBlock.blockDirection - 1
     Else
        currentBlock.blockDirection = 3
     End If
  End If
'检测碰撞
   If isBlockFilled = True Then
      If rotateOption = True Then
         If currentBlock.blockDirection = 0 Then
         currentBlock.blockDirection = 3
         Else
         currentBlock.blockDirection = currentBlock.blockDirection - 1
         End If
      Else
         If currentBlock.blockDirection = 3 Then
         currentBlock.blockDirection = 0
         Else
         currentBlock.blockDirection = currentBlock.blockDirection + 1
         End If
      End If
   End If
'重画方块
   Call drawBlock
End Sub

Sub drawBlock()
    For j = 0 To 3
      For i = 0 To 3
        If blnBlock(currentBlock.blockType, currentBlock.blockDirection, i, j) Then
          blnGrid(i + currentBlock.blockPosition.Y, j + currentBlock.blockPosition.X) = True
          lngColor(i + currentBlock.blockPosition.Y, j + currentBlock.blockPosition.X) = currentBlock.blockColor
          Picture1.Line (22 * (j + currentBlock.blockPosition.X) + 4, 22 * (i + currentBlock.blockPosition.Y) + 4)-(22 * (j + currentBlock.blockPosition.X) + 20, 22 * (i + currentBlock.blockPosition.Y) + 20), currentBlock.blockColor, BF
        End If
      Next i
   Next j
End Sub

Sub eraseBlock()
   For j = 0 To 3
      For i = 0 To 3
        If blnBlock(currentBlock.blockType, currentBlock.blockDirection, i, j) Then
          blnGrid(i + currentBlock.blockPosition.Y, j + currentBlock.blockPosition.X) = False
          lngColor(i + currentBlock.blockPosition.Y, j + currentBlock.blockPosition.X) = &H8000000F
          Picture1.Line (22 * (j + currentBlock.blockPosition.X) + 4, 22 * (i + currentBlock.blockPosition.Y) + 4)-(22 * (j + currentBlock.blockPosition.X) + 20, 22 * (i + currentBlock.blockPosition.Y) + 20), &H8000000F, BF
        End If
      Next i
   Next j
End Sub

Function isBlockFilled()
   For j = 0 To 3
      For i = 0 To 3
       If blnBlock(currentBlock.blockType, currentBlock.blockDirection, i, j) Then
         If blnGrid(i + currentBlock.blockPosition.Y, j + currentBlock.blockPosition.X) = True Then
           isBlockFilled = True
           Exit Function
         End If
       End If
      Next i
   Next j
   isBlockFilled = False
End Function

Function isBlockLeftOut()
   For j = 0 To 3
      For i = 0 To 3
       If blnBlock(currentBlock.blockType, currentBlock.blockDirection, i, j) Then
         If currentBlock.blockPosition.X + j = 0 Then
           For k = 0 To 11
             If blnGrid(currentBlock.blockPosition.Y + i, k) = True Then
                isBlockLeftOut = True
                Exit Function
             End If
           Next k
         End If
       End If
      Next i
    Next j
    isBlockLeftOut = False
End Function

Function isBlockRightOut()
  For j = 0 To 3
      For i = 0 To 3
       If blnBlock(currentBlock.blockType, currentBlock.blockDirection, i, j) Then
         If currentBlock.blockPosition.X + j = 11 Then
           For k = 0 To 11
             If blnGrid(currentBlock.blockPosition.Y + i, k) = True Then
                isBlockRightOut = True
                Exit Function
             End If
           Next k
         End If
       End If
      Next i
    Next j
   isBlockRightOut = False
End Function

Function stopBlockRotate()
  For j = 0 To 3
   For i = 0 To 3
     If blnBlock(currentBlock.blockType, currentBlock.blockDirection, i, j) Then
       Select Case currentBlock.blockType
         Case 0
         If currentBlock.blockDirection = 0 Or currentBlock.blockDirection = 2 Then
            If currentBlock.blockPosition.X + j < 3 Then stopBlockRotate = True
            Exit Function
         End If
         If currentBlock.blockDirection = 1 Or currentBlock.blockDirection = 3 Then
            If currentBlock.blockPosition.X + j < 0 Then stopBlockRotate = True
            Exit Function
         End If
         Case 1
         If currentBlock.blockDirection = 0 Or currentBlock.blockDirection = 2 Then
            If currentBlock.blockPosition.X + j < 0 Then stopBlockRotate = True
            Exit Function
         End If
         If currentBlock.blockDirection = 1 Or currentBlock.blockDirection = 3 Then
            If currentBlock.blockPosition.X + j < 1 Then stopBlockRotate = True
            Exit Function
         End If
         Case 2
         If currentBlock.blockDirection = 0 Or currentBlock.blockDirection = 2 Then
            If currentBlock.blockPosition.X + j < 0 Then stopBlockRotate = True
            Exit Function
         End If
         If currentBlock.blockDirection = 1 Or currentBlock.blockDirection = 3 Then
            If currentBlock.blockPosition.X + j < 1 Then stopBlockRotate = True
            Exit Function
         End If
         Case 3
         If currentBlock.blockDirection = 0 Or currentBlock.blockDirection = 2 Then
            If currentBlock.blockPosition.X + j < 0 Then stopBlockRotate = True
            Exit Function
         End If
         If currentBlock.blockDirection = 1 Or currentBlock.blockDirection = 3 Then
            If currentBlock.blockPosition.X + j < 1 Then stopBlockRotate = True
            Exit Function
         End If
       End Select
     End If
   Next i
  Next j
  stopBlockRotate = False
End Function

Function isBlockGetBottom()
    For j = 0 To 3
      For i = 0 To 3
       If blnBlock(currentBlock.blockType, currentBlock.blockDirection, i, j) Then
         If currentBlock.blockPosition.Y + i = 22 Then
           For k = 0 To 11
             If blnGrid(currentBlock.blockPosition.Y + i, k) = True Then
                isBlockGetBottom = True
                Exit Function
             End If
           Next k
         End If
       End If
      Next i
    Next j
    isBlockGetBottom = False
End Function

Sub resumeBlock()
    currentBlock = nextBlock
    currentBlock.blockPosition.X = Int(Rnd * 8)
    Call nextBlockGenerate
    Call clrNextBlockZone
    If showNextBlock Then Call dispNextBlock
End Sub

Sub autoRedrawAll()
    For i = 0 To 22
       For j = 0 To 11
         If blnGrid(i, j) = False Then GoSub lp
       Next j
       chkFull(i) = True
       fullNum = fullNum + 1
lp: Next i
    For i = 0 To 22
      If chkFull(i) = True Then
         redraw (i)
         sndPlaySound App.Path & "\chimes.wav", SND_ASYNC
      End If
    Next i
End Sub

Sub redraw(row As Integer)
'重画游戏区
    For i = row To 1 Step -1
      For j = 0 To 11
        blnGrid(i, j) = blnGrid(i - 1, j)
        lngColor(i, j) = lngColor(i - 1, j)
        Picture1.Line (22 * j + 4, 22 * i + 4)-(22 * j + 20, 22 * i + 20), lngColor(i, j), BF
      Next j
    Next i
'重新更改变量值
    chkFull(row) = False
    fullNum = fullNum - 1
    score = score + 100
    txtScore.Text = CStr(score)
    If score = 1000 Then
       speed = speed + 1
       txtSpeed.Text = CStr(speed)
       fallGrid = fallGrid * 2
       Timer1.Interval = 500 / fallGrid
    End If
End Sub

Sub chkGameOver()
   For j = 0 To 11
      If blnGrid(1, j) = True Then
         isGameOver = True
         isGameStart = False
         MsgBox "游戏结束！大侠，请重新来过！", vbInformation, "系统消息"
         Timer1.Enabled = False
   '如果得分超过历史最高分，记录
         If Int(highestScore) < Int(txtScore.Text) Then
         highestScore = txtScore.Text
         Load Form5
         Form5.Show
         End If
         Exit Sub
      End If
   Next j
End Sub

Private Sub Timer1_Timer()
   Call fallBlock
End Sub