frmmain.frm

得用Visual Basic编写的小游戏-俄罗斯方块。

VERSION 5.00
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "俄罗斯方块"
   ClientHeight    =   6330
   ClientLeft      =   45
   ClientTop       =   720
   ClientWidth     =   5100
   Icon            =   "frmMain.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   422
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   340
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame4 
      Caption         =   "当前速度"
      Height          =   855
      Left            =   3330
      TabIndex        =   6
      Top             =   3090
      Width           =   1635
      Begin VB.TextBox txtSpeed 
         Alignment       =   1  'Right Justify
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   14.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   435
         Left            =   135
         Locked          =   -1  'True
         MultiLine       =   -1  'True
         TabIndex        =   7
         Text            =   "frmMain.frx":030A
         Top             =   240
         Width           =   1395
      End
   End
   Begin VB.Frame Frame3 
      Caption         =   "当前分"
      Height          =   855
      Left            =   3330
      TabIndex        =   4
      Top             =   4035
      Width           =   1635
      Begin VB.TextBox txtScore 
         Alignment       =   1  'Right Justify
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   14.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   435
         Left            =   120
         Locked          =   -1  'True
         MultiLine       =   -1  'True
         TabIndex        =   5
         Text            =   "frmMain.frx":030E
         Top             =   255
         Width           =   1395
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "最高分"
      Height          =   855
      Left            =   3330
      TabIndex        =   2
      Top             =   2175
      Width           =   1635
      Begin VB.TextBox txtHigh 
         Alignment       =   1  'Right Justify
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   14.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   435
         Left            =   135
         Locked          =   -1  'True
         MultiLine       =   -1  'True
         TabIndex        =   3
         Text            =   "frmMain.frx":0312
         Top             =   285
         Width           =   1395
      End
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   300
      Left            =   3885
      Top             =   5685
   End
   Begin VB.PictureBox picGrid 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00FFFFFF&
      ForeColor       =   &H00FFFFFF&
      Height          =   6060
      Left            =   90
      ScaleHeight     =   400
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   200
      TabIndex        =   0
      Top             =   120
      Width           =   3060
   End
   Begin VB.Frame Frame1 
      Caption         =   "下一个"
      Height          =   1830
      Left            =   3330
      TabIndex        =   1
      Top             =   165
      Width           =   1650
      Begin VB.PictureBox picNext 
         AutoRedraw      =   -1  'True
         BackColor       =   &H00FFFFFF&
         Height          =   1260
         Left            =   180
         ScaleHeight     =   80
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   80
         TabIndex        =   8
         Top             =   345
         Width           =   1260
      End
   End
   Begin VB.Label lblStart 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      BorderStyle     =   1  'Fixed Single
      Caption         =   "开 始"
      BeginProperty Font 
         Name            =   "黑体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   375
      Left            =   3600
      MouseIcon       =   "frmMain.frx":0316
      MousePointer    =   99  'Custom
      TabIndex        =   9
      Top             =   5130
      Width           =   1050
   End
   Begin VB.Menu mnjFile 
      Caption         =   "文件"
      Begin VB.Menu mnuOption 
         Caption         =   "选项(&O)..."
      End
      Begin VB.Menu mnuAbout 
         Caption         =   "关于(&A)..."
      End
      Begin VB.Menu mnuS 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出"
      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
Option Base 0

Private blnGrid(0 To 19, 0 To 9) As Boolean                 '网格
Private lngColor(0 To 19, 0 To 9) As Long                   '网格绘制颜色
Private blnBlock(0 To 4, 0 To 3, 0 To 3, 0 To 3) As Boolean '五种方块的四种不同方位
Private blnStarted As Boolean       '是否已开始玩

Dim intTypeCur As Integer       '当前方块的类型
Dim lngColorCur As Long         '当前方块的颜色

Dim intOrieCur As Integer       '当前方块的方位
Dim intOrieNext As Integer      '当前方块的下一个方位
Dim intXCur As Integer          '当前方块的当前位置
Dim intYCur As Integer
Dim intXNext As Integer         '当前方块的下一个位置
Dim intYNext As Integer
    
Public intDownDistance As Integer   '快速下降时的下降距离
Public blnClockWise As Boolean      '方块旋转方向
Public blnShowNext As Boolean       '是否显示下一个方块
Public blnScheme As Boolean         '按键方案


Dim lngScore As Long        '得分
Dim intTypeNew As Integer       '下一个方块的类型
Dim lngColorNew As Long         '下一个方块的颜色
Dim intOrieNew As Integer       '下一个方块的方位
Dim lngHighScore As Long
Dim blnRedraw As Boolean

Private Sub ShowBlock()         '显示下落的方块
    Dim i As Integer, j As Integer
    '去掉旧图象
    For i = 0 To 3
        If i + intYCur >= 0 And i + intYCur <= 19 Then            '如果在大方框外,则不绘制
            For j = 0 To 3
                If j + intXCur >= 0 And j + intXCur <= 9 Then
                    If (j + intXCur >= 0) And (j + intXCur <= 9) And (blnBlock(intTypeCur, intOrieCur, i, j)) And Not blnGrid(i + intYCur, j + intXCur) Then
                        picGrid.Line ((j + intXCur) * 20 + 2, (i + intYCur) * 20 + 2)-((j + intXCur) * 20 + 19, (i + intYCur) * 20 + 19), vbBlack, B
                        picGrid.Line ((j + intXCur) * 20 + 4, (i + intYCur) * 20 + 4)-((j + intXCur) * 20 + 17, (i + intYCur) * 20 + 17), vbWhite, BF
                    End If
                End If
            Next
        End If
    Next
    '画新图象
    For i = 0 To 3
        If i + intYNext >= 0 And i + intYNext <= 19 Then        '如果在大方框外,则不绘制
            For j = 0 To 3
                If (j + intXNext >= 0) And (j + intXNext <= 9) And (blnBlock(intTypeCur, intOrieNext, i, j)) Then
                    picGrid.Line ((j + intXNext) * 20 + 2, (i + intYNext) * 20 + 2)-((j + intXNext) * 20 + 19, (i + intYNext) * 20 + 19), lngColorCur, B
                    picGrid.Line ((j + intXNext) * 20 + 4, (i + intYNext) * 20 + 4)-((j + intXNext) * 20 + 17, (i + intYNext) * 20 + 17), lngColorCur, BF
                End If
            Next
        End If
    Next