form1.frm

扫雷 很牛的游戏

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "俄罗斯方块"
   ClientHeight    =   5220
   ClientLeft      =   3375
   ClientTop       =   2235
   ClientWidth     =   4680
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5220
   ScaleWidth      =   4680
   Begin VB.HScrollBar HScroll1 
      Height          =   135
      Left            =   120
      Max             =   7
      TabIndex        =   7
      Top             =   3315
      Width           =   1695
   End
   Begin VB.TextBox Text2 
      Enabled         =   0   'False
      Height          =   270
      Left            =   120
      TabIndex        =   5
      Text            =   "0"
      Top             =   2640
      Width           =   615
   End
   Begin VB.TextBox Text1 
      Alignment       =   1  'Right Justify
      Enabled         =   0   'False
      Height          =   270
      Left            =   120
      TabIndex        =   3
      Text            =   "0"
      Top             =   2040
      Width           =   975
   End
   Begin VB.Timer Timer2 
      Interval        =   200
      Left            =   1560
      Top             =   600
   End
   Begin VB.Timer Timer1 
      Left            =   1560
      Top             =   960
   End
   Begin VB.CommandButton Command1 
      Caption         =   "开始"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   120
      TabIndex        =   1
      Top             =   4560
      Width           =   1695
   End
   Begin VB.Label Label6 
      BorderStyle     =   1  'Fixed Single
      Caption         =   $"Form1.frx":030A
      Height          =   855
      Left            =   120
      TabIndex        =   9
      Top             =   3600
      Width           =   1695
   End
   Begin VB.Label Label5 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "调速"
      Height          =   255
      Left            =   120
      TabIndex        =   8
      Top             =   3000
      Width           =   615
   End
   Begin VB.Label Label4 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "阶段"
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   2400
      Width           =   615
   End
   Begin VB.Label Label3 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "得分"
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   1800
      Width           =   615
   End
   Begin VB.Shape Shape2 
      FillStyle       =   0  'Solid
      Height          =   255
      Index           =   0
      Left            =   720
      Top             =   840
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      BorderStyle     =   1  'Fixed Single
      Height          =   1455
      Left            =   120
      TabIndex        =   2
      Top             =   0
      Width           =   1335
   End
   Begin VB.Shape Shape1 
      BackColor       =   &H80000008&
      FillStyle       =   0  'Solid
      Height          =   255
      Index           =   0
      Left            =   3120
      Tag             =   "0"
      Top             =   2760
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      BorderStyle     =   1  'Fixed Single
      Height          =   4215
      Left            =   2040
      TabIndex        =   0
      Top             =   0
      Width           =   2295
   End
   Begin VB.Menu GameList 
      Caption         =   "游戏菜单"
      Begin VB.Menu GameRool 
         Caption         =   "游戏规则"
      End
      Begin VB.Menu o 
         Caption         =   "-"
      End
      Begin VB.Menu NewGame 
         Caption         =   "重新开始"
      End
      Begin VB.Menu EndGame 
         Caption         =   "结束游戏"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim a(4) As shapetype, b(4) As shapetype, n As Integer, pot As Integer, among As Long, speed As Integer

Private Sub Form_Load()
Label1.Width = 10 * Shape1(0).Width
Label1.Height = 20 * Shape1(0).Width
Label2.Width = 7 * Shape1(0).Width
Label2.Height = Label2.Width
Timer2.Enabled = False
among = 0
For i = 1 To 20
    For j = 1 To 10
        k = k + 1
        Load Shape1(k)
        Shape1(k).Left = Label1.Left + (j - 1) * Shape1(0).Width
        Shape1(k).Top = Label1.Top + (i - 1) * Shape1(0).Height
        Shape1(k).Visible = True
        Shape1(k).FillColor = &H0&
        Shape1(k).Tag = 0
    Next j
Next i
k = 0
For i = 1 To 7
    For j = 1 To 7
        k = k + 1
        Load Shape2(k)
        Shape2(k).Left = Label2.Left + (j - 1) * Shape2(0).Width
        Shape2(k).Top = Label2.Top + (i - 1) * Shape2(0).Height
        Shape2(k).Tag = 0
        Shape2(k).FillColor = &H0&
        Shape2(k).Visible = True
    Next j
Next i
End Sub

Private Sub Command1_Click()
Call out
Call out
Command1.Enabled = False
HScroll1.Enabled = False
Timer1.Interval = 450 - speed * 50
End Sub

Private Sub Timer1_Timer()
Dim a1(4) As shapetype, changeright As Boolean
changeright = True
For i = 0 To 3
    a1(i).x = a(i).x
    a1(i).y = a(i).y + 1
Next i
For i = 0 To 3
    If a1(i).y < 20 And a1(i).y >= 0 Then
    If Shape1((a1(i).y) * 10 + a1(i).x).Tag > 0 Then
       changeright = False
    End If
    End If
    If a1(i).y > 19 Then changeright = False
Next i
If changeright = True Then
   For i = 0 To 3
       If a(i).y >= 0 Then Shape1(a(i).x + (a(i).y) * 10).FillColor = &H0&
       a(i).x = a1(i).x: a(i).y = a1(i).y
   Next i
   For i = 0 To 3
        If a(i).y >= 0 Then Shape1(a(i).x + (a(i).y) * 10).FillColor = &HFFFFFF
   Next i
Else
   For i = 0 To 3
       If a(i).y >= 0 Then
          Shape1(a(i).x + a(i).y * 10).FillColor = &HFFFFFF
          Shape1(a(i).x + a(i).y * 10).Tag = 1
       End If
   Next i
   Call check
   For i = 1 To 10
       If Shape1(i).Tag > 0 Then
          MsgBox "游戏结束"
          Call init
          Exit Sub
       End If
   Next i
End If
End Sub

Private Sub Timer2_Timer()
For i = 19 To 0 Step -1
    For j = 1 To 10
        If Shape1(i * 10 + j).Tag > 1 Then
        Shape1(i * 10 + j).FillColor = &H0&
        Shape1((i + Shape1(i * 10 + j).Tag - 1) * 10 + j).FillColor = &HFFFFFF
        Shape1((i + Shape1(i * 10 + j).Tag - 1) * 10 + j).Tag = 1
        Shape1(i * 10 + j).Tag = 0
        End If
    Next j
Next i
Timer1.Enabled = True
Timer2.Enabled = False
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim a1(4) As shapetype, change As Boolean, changetype As Integer, k As Integer
If KeyCode = 37 Or 39 Then changetype = 1
If KeyCode = 38 Then changetype = 2
If KeyCode = 40 Then changetype = 3
If KeyCode = 32 Then changetype = 4
change = True
Select Case changetype
       Case 1:
            For i = 0 To 3
                a1(i).x = a(i).x + KeyCode - 38
                a1(i).y = a(i).y
                If a1(i).x < 1 Or a1(i).x > 10 Then Exit Sub
                If a1(i).y >= 0 Then
                If Shape1(a1(i).x + (a1(i).y) * 10).Tag > 0 Then Exit Sub
                End If
            Next i
            For i = 0 To 3
                If a(i).y >= 0 Then Shape1(a(i).x + (a(i).y) * 10).FillColor = &H0&
            Next i
            For i = 0 To 3
                a(i).x = a1(i).x
                a(i).y = a1(i).y
                If a(i).y >= 0 Then Shape1(a(i).x + (a(i).y) * 10).FillColor = &HFFFFFF
            Next i
       Case 2:
            If pot = 7 Then Exit Sub
            For i = 1 To 3
                a1(i).x = a(0).x + a(i).y - a(0).y
                a1(i).y = a(0).y + a(0).x - a(i).x
                If a1(i).x < 1 Or a1(i).x > 10 Or a1(i).y > 19 Then Exit Sub
                If a1(i).y >= 0 Then
                   If Not Shape1(a1(i).x + (a1(i).y) * 10).Tag = 0 Then Exit Sub
                   If Not Shape1(a(i).x + (a1(i).y) * 10).Tag = 0 Then Exit Sub
                End If
                If a(i).y >= 0 Then
                   If Not Shape1(a1(i).x + (a(i).y) * 10).Tag = 0 Then Exit Sub
                End If
            Next i
            For i = 1 To 3
                   If a(i).y >= 0 And a(i).y <= 19 And Not (a(i).x = a(i - 1).x And a(i).y = a(i - 1).y) Then Shape1(a(i).x + (a(i).y) * 10).FillColor = &H0&
                   a(i).x = a1(i).x
                   a(i).y = a1(i).y
                   If a(i).y >= 0 And a(i).y <= 19 Then Shape1(a(i).x + (a(i).y) * 10).FillColor = &HFFFFFF
            Next i
        Case 3:
            Timer1.Interval = 50
        Case 4:
            k = 0: i = 0
            Do While i <= 25 And k = 0
                i = i + 1
                For j = 0 To 3
                    a1(j).x = a(j).x
                    a1(j).y = a(j).y
                    a1(j).y = a1(j).y + i
                    If a1(j).y > 19 Then
                       k = i
                    Else
                       If a1(j).y >= 0 Then
                       If Shape1(a1(j).x + (a1(j).y) * 10).Tag > 0 Then
                          k = i
                       End If
                       End If
                    End If
                Next j
           Loop
           For i = 0 To 3
               If a(i).y >= 0 Then Shape1(a(i).x + (a(i).y) * 10).FillColor = &H0&
           Next i
           For i = 0 To 3
               a(i).y = a(i).y + k - 1
               If a(i).y >= 0 Then
                  Shape1(a(i).x + (a(i).y) * 10).FillColor = &HFFFFFF
                  Shape1(a(i).x + (a(i).y) * 10).Tag = 1
               End If
           Next i
           Call check
End Select
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
        Timer1.Interval = 450 - speed * 50
End Sub

Private Sub NewGame_Click()
Call init
End Sub

Private Sub EndGame_Click()
        i = MsgBox("真的退出吗?", vbYesNo, "退出游戏")
        If i = 6 Then End
End Sub

Private Sub GameRool_Click()
        i = MsgBox("按←键左移动方块" & Chr(13) & "按→键右移动方块" & Chr(13) & "按↑键旋转方块" & Chr(13) & "按↓键加速方块" & Chr(13) & "按空格键让方块沉底", , "键盘设定")
        i = MsgBox("积分的规则是:" & Chr(13) & " 同时积1行为10分，2行为30分，三行为50分，四行为70分" & Chr(13) & "积满100分为第一阶段，积满200分第二阶段，" & Chr(13) & "400分第三阶段，往后分数增倍阶段增1，速度随着阶段相应增加", , "积分设定")
End Sub
Private Sub HScroll1_Change()
        speed = HScroll1.Value
        Text2 = speed
        If speed = 0 Then among = 0: Exit Sub
        m = 1
        For i = 1 To speed - 1
            m = m * 2
        Next i
        among = m * 100
End Sub

Sub out()
For i = 0 To 3
    a(i).x = b(i).x
    a(i).y = b(i).y
Next i
Randomize
pot = n
n = Int(Rnd * 7 + 1)
Select Case n
       Case 1:
               b(0).x = 5: b(1).x = 5: b(2).x = 5: b(3).x = 5
               b(0).y = -2: b(1).y = -1: b(2).y = -3: b(3).y = -4
       Case 2:
               b(0).x = 5: b(1).x = 5: b(2).x = 4: b(3).x = 6
               b(0).y = -1: b(1).y = -2: b(2).y = -1: b(3).y = -1
       Case 3:
               b(0).x = 5: b(1).x = 5: b(2).x = 5: b(3).x = 4
               b(0).y = -2: b(1).y = -1: b(2).y = -3: b(3).y = -3
       Case 4:
               b(0).x = 5: b(1).x = 5: b(2).x = 5: b(3).x = 6
               b(0).y = -2: b(1).y = -1: b(2).y = -3: b(3).y = -3
       Case 5:
               b(0).x = 5: b(1).x = 5: b(2).x = 4: b(3).x = 6
               b(0).y = -1: b(1).y = -2: b(2).y = -2: b(3).y = -1
       Case 6:
               b(0).x = 5: b(1).x = 5: b(2).x = 4: b(3).x = 6
               b(0).y = -1: b(1).y = -2: b(2).y = -1: b(3).y = -2
       Case 7:
               b(0).x = 5: b(1).x = 5: b(2).x = 6: b(3).x = 6
               b(0).y = -1: b(1).y = -2: b(2).y = -1: b(3).y = -2
End Select
For i = 1 To 49
    Shape2(i).FillColor = &H0&
Next i
For i = 0 To 3
    Shape2(b(i).x - 1 + (b(i).y + 5) * 7).FillColor = &HFFFFFF
Next i
End Sub

Sub check()
Dim d As Integer
d = 0
For i = 19 To 0 Step -1
    k = 0
    For j = 1 To 10
        If Shape1(i * 10 + j).Tag > 0 Then
           Shape1(i * 10 + j).Tag = Shape1(i * 10 + j).Tag + d
           k = k + 1
        End If
    Next j
    If k = 10 Then
       d = d + 1
       For j = 1 To 10
           Shape1(i * 10 + j).FillColor = &H0&
           Shape1(i * 10 + j).Tag = 0
       Next j
    End If
Next i
If Not d = 0 Then
   Timer1.Enabled = False
   Timer2.Enabled = True
   Text1.Text = Val(Text1.Text) + (2 * d - 1) * 10
   among = among + (2 * d - 1) * 10
   k = Int(among / 100)
   Select Case k
          Case 0: speed = 0
          Case 1: speed = 1
          Case 2: speed = 2
          Case 4: speed = 3
          Case 8: speed = 4
          Case 16: speed = 5
          Case 32: speed = 6
          Case 64: speed = 7
   End Select
   Text2.Text = speed
End If
Call out
End Sub

Sub init()
    Timer1.Interval = 0
    For i = 0 To 3
        a(i).x = 0
        a(i).y = -1
    Next i
    For i = 0 To 19
        For j = 1 To 10
            Shape1(i * 10 + j).Tag = 0
            Shape1(i * 10 + j).FillColor = &H0&
        Next j
    Next i
    For i = 0 To 6
        For j = 1 To 7
            Shape2(i * 7 + j).Tag = 0
            Shape2(i * 7 + j).FillColor = &H0&
        Next j
    Next i
    Command1.Enabled = True
    HScroll1.Enabled = True
    HScroll1.Value = 0
    speed = 0
    among = 0
    Text1 = 0: Text2 = 0
End Sub