frmmain.frm

一个俄罗斯方块游戏

         Top             =   2640
         Width           =   1800
      End
   End
   Begin VB.Menu mnuGame 
      Caption         =   "游戏"
      Begin VB.Menu mnuStart 
         Caption         =   "开始"
         Shortcut        =   {F2}
      End
      Begin VB.Menu mnuPause 
         Caption         =   "暂停"
         Shortcut        =   {F3}
      End
   End
   Begin VB.Menu mnuGameLevels 
      Caption         =   "游戏等级"
      Begin VB.Menu mnuGameLevel 
         Caption         =   "0"
         Index           =   0
      End
   End
   Begin VB.Menu mnuRobotLevel 
      Caption         =   "机器人等级"
      Begin VB.Menu mnuRBLevel 
         Caption         =   "0"
         Index           =   0
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Const SND_FILENAME = &H20000
Private Const SND_ASYNC = &H1
Private Const SND_NOWAIT = &H2000

Private m_Assist As ITetrisAssist
Private m_Assist1 As ITetrisAssist

Private m_NextTetris(1) As Collection

Private m_Actions As New Collection
Private m_Actions1 As New Collection

Private Type GameState
   Level As Long
   Tetris As Long
   Score As Long
   Rows As Long
   RowsGive As Long
   Wins As Long
End Type

Private m_GameState(1) As GameState

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
   Select Case KeyCode
   Case vbKeyLeft
      tetPanel(1).MoveLeft
   Case vbKeyRight
      tetPanel(1).MoveRight
   Case vbKeyDown
      tetPanel(1).DropDown
   Case vbKeyUp
      tetPanel(1).TurnLeft
   End Select
End Sub


Private Sub Form_Load()
   Frame1.BackColor = Me.BackColor
   
   Set m_Assist = New CTetAssist
   Set m_Assist1 = New CTetAssist
   
   Set m_NextTetris(0) = New Collection
   Set m_NextTetris(1) = New Collection
   
   Dim I As Long
   For I = 1 To 10
      Load mnuRBLevel(I)
      mnuRBLevel(I).Caption = I
      mnuRBLevel(I).Visible = True
   Next
   mnuRBLevel_Click 5
   
   For I = 1 To 10
      Load mnuGameLevel(I)
      mnuGameLevel(I).Caption = I
      mnuGameLevel(I).Visible = True
   Next
   
   mnuGameLevel_Click 5
   
   RefreshGameState
End Sub

Private Sub Form_Resize()
   Frame1.Move (Me.ScaleWidth - Frame1.Width) / 2, (Me.ScaleHeight - Frame1.Height) / 2
End Sub

Private Sub mnuGameLevel_Click(Index As Integer)
   tetPanel(0).Level = Index
   tetPanel(1).Level = Index
   m_GameState(0).Level = Index
   m_GameState(1).Level = Index
   
   Dim I As Long
   For I = 0 To mnuGameLevel.UBound
      mnuGameLevel(I).Checked = False
   Next
   
   mnuGameLevel(Index).Checked = True
End Sub

Private Sub mnuPause_Click()
   If mnuPause.Checked Then
      tetPanel(1).ResumeGame
      tetPanel(0).ResumeGame
      mnuPause.Checked = False
   Else
      tetPanel(1).PauseGame
      tetPanel(0).PauseGame
      mnuPause.Checked = True
   End If
End Sub

Private Sub mnuRBLevel_Click(Index As Integer)
   Timer1.Interval = (11 - Index) * 30

   Dim I As Long
   For I = 0 To mnuRBLevel.UBound
      mnuRBLevel(I).Checked = False
   Next
   
   mnuRBLevel(Index).Checked = True
End Sub

Private Sub mnuStart_Click()
   Randomize
   
   Dim nTetris As Long
   nTetris = Int(Rnd * 7)
   
   Set m_NextTetris(0) = New Collection
   Set m_NextTetris(1) = New Collection
   
   m_Assist.Reset
   m_Assist1.Reset
   
   Dim I As Long
   For I = 0 To 1
      NextTetris1(I).Tetris = nTetris
   
      With tetPanel(I)
         .ClearPanel
         .BeginGame
         .SetActTetris -1
      End With
      
      SetNextTetris I
   Next
   
   For I = 0 To 1
      With m_GameState(I)
         .Level = tetPanel(I).Level
         .Rows = 0
         .RowsGive = 0
         .Score = 0
         .Tetris = 0
      End With
   Next
   
   Call RefreshGameState
End Sub

Private Sub tetPanel_GameOver(Index As Integer)
   tetPanel(0).EndGame
   tetPanel(1).EndGame
   
   m_GameState(1 - Index).Wins = m_GameState(1 - Index).Wins + 1
   Call RefreshGameState
End Sub

Private Sub tetPanel_RowsClear(Index As Integer, ByVal ClearLines As Long)
   If ClearLines > 0 Then
      PlaySound "C:\WINNT\Media\Microsoft Office 2000\Laser.WAV", 0, SND_FILENAME Or SND_ASYNC Or SND_NOWAIT
   End If
   
   With m_GameState(Index)
      .Rows = .Rows + ClearLines
      .Score = .Score + (ClearLines * 2 - 1) * 100
      If ClearLines >= 2 Then
         .RowsGive = .RowsGive + ClearLines - 1
         tetPanel(1 - Index).GrowLines ClearLines - 1, 1
      End If
   End With
   
   Call RefreshGameState
End Sub

Private Sub tetPanel_TetrisDrop(Index As Integer)
   SetNextTetris Index

   m_GameState(Index).Tetris = m_GameState(Index).Tetris + 1
   Call RefreshGameState
End Sub



Private Sub Timer1_Timer()
   If tetPanel(0).State <> btt_gs_Playing Then
      Exit Sub
   End If
   
   If m_Actions.Count = 0 Then
      Dim nPanel() As Byte
      Dim nTetris As Long, nAngle As Long, nLeft As Long, nTop As Long

      With tetPanel(0)
         .GetPanel nPanel
         .GetActTetris nTetris, nAngle, nLeft, nTop
      End With

      m_Assist.GetActions nPanel, nTetris, nAngle, nLeft, nTop, m_Actions
   End If
   
   If m_Actions.Count > 0 Then
      Dim nAction As btt_Actions
      nAction = m_Actions.Item(1)
      m_Actions.Remove (1)
      
      Select Case nAction
      Case btt_ta_MoveLeft
         tetPanel(0).MoveLeft
      Case btt_ta_MoveRight
         tetPanel(0).MoveRight
      Case btt_ta_MoveDown
         tetPanel(0).MoveDown
      Case btt_ta_TurnLeft
         tetPanel(0).TurnLeft
      Case btt_ta_TurnRight
         tetPanel(0).TurnRight
      Case btt_ta_DropDown
         tetPanel(0).DropDown
      End Select
   End If
   
   If tetPanel(1).State <> btt_gs_Playing Then
      Exit Sub
   End If
   
   If m_Actions1.Count = 0 Then
      With tetPanel(1)
         .GetPanel nPanel
         .GetActTetris nTetris, nAngle, nLeft, nTop
      End With

      m_Assist1.GetActions nPanel, nTetris, nAngle, nLeft, nTop, m_Actions1
   End If
   
   If m_Actions1.Count > 0 Then
      nAction = m_Actions1.Item(1)
      m_Actions1.Remove (1)
      
      Select Case nAction
      Case btt_ta_MoveLeft
         tetPanel(1).MoveLeft
      Case btt_ta_MoveRight
         tetPanel(1).MoveRight
      Case btt_ta_MoveDown
         tetPanel(1).MoveDown
      Case btt_ta_TurnLeft
         tetPanel(1).TurnLeft
      Case btt_ta_TurnRight
         tetPanel(1).TurnRight
      Case btt_ta_DropDown
         tetPanel(1).DropDown
      End Select
   End If
End Sub


Private Sub GenNextTetris()
   Dim nTetris As Long
   
   nTetris = Int(Rnd * 7)
   
   m_NextTetris(0).Add nTetris
   m_NextTetris(1).Add nTetris
End Sub


Private Sub SetNextTetris(ByVal Index As Long)
   tetPanel(Index).SetActTetris NextTetris1(Index).Tetris
   
   If m_NextTetris(Index).Count = 0 Then
      GenNextTetris
   End If
   
   NextTetris1(Index).Tetris = m_NextTetris(Index).Item(1)
   m_NextTetris(Index).Remove 1
End Sub


Private Sub RefreshGameState()
   Dim I As Long
   For I = 0 To 1
      With m_GameState(I)
         lblLevel(I).Caption = .Level
         lblTetris(I).Caption = .Tetris
         lblRows(I).Caption = .Rows
         If I = 0 Then
            lblRowsGive(I).Caption = .RowsGive & " ->"
         Else
            lblRowsGive(I).Caption = "<- " & .RowsGive
         End If
         lblScore(I).Caption = .Score
         lblWins(I).Caption = .Wins
      End With
   Next
End Sub