📄 frmmain.frm
字号:
VERSION 5.00
Object = "{C1A8AF28-1257-101B-8FB0-0020AF039CA3}#1.1#0"; "MCI32.OCX"
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "俄罗斯方块"
ClientHeight = 4788
ClientLeft = 36
ClientTop = 324
ClientWidth = 4500
FillStyle = 0 'Solid
Icon = "frmMain.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 399
ScaleMode = 3 'Pixel
ScaleWidth = 375
StartUpPosition = 2 '屏幕中心
Begin MCI.MMControl MMC4
Height = 372
Left = 780
TabIndex = 10
Top = 1380
Visible = 0 'False
Width = 2832
_ExtentX = 4995
_ExtentY = 656
_Version = 393216
Enabled = 0 'False
DeviceType = ""
FileName = ""
End
Begin MCI.MMControl MMC3
Height = 372
Left = 780
TabIndex = 9
Top = 1020
Visible = 0 'False
Width = 2832
_ExtentX = 4995
_ExtentY = 656
_Version = 393216
Enabled = 0 'False
DeviceType = ""
FileName = ""
End
Begin MCI.MMControl MMC1
Height = 372
Left = 780
TabIndex = 7
Top = 300
Visible = 0 'False
Width = 2832
_ExtentX = 4995
_ExtentY = 656
_Version = 393216
Enabled = 0 'False
DeviceType = ""
FileName = ""
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 400
Left = 3840
Top = 4320
End
Begin VB.CommandButton cmdExit
BackColor = &H00FFC0C0&
Caption = "退出(&X)"
Height = 312
Left = 3660
TabIndex = 6
Top = 3600
Width = 792
End
Begin VB.CommandButton cmdStop
BackColor = &H00FFC0C0&
Caption = "停止(&T)"
Enabled = 0 'False
Height = 312
Left = 3660
TabIndex = 3
Top = 3180
Width = 792
End
Begin VB.CommandButton cmdStart
BackColor = &H00FFC0C0&
Caption = "开始(&S)"
Height = 312
Left = 3660
TabIndex = 2
Top = 2760
Width = 792
End
Begin VB.PictureBox PicPreview
BackColor = &H00000000&
FillColor = &H0000FFFF&
FillStyle = 0 'Solid
ForeColor = &H00000000&
Height = 792
Left = 3660
ScaleHeight = 6
ScaleMode = 0 'User
ScaleWidth = 6
TabIndex = 1
Top = 120
Width = 792
End
Begin MCI.MMControl MMC2
Height = 372
Left = 780
TabIndex = 8
Top = 660
Visible = 0 'False
Width = 2832
_ExtentX = 4995
_ExtentY = 656
_Version = 393216
Enabled = 0 'False
DeviceType = ""
FileName = ""
End
Begin VB.PictureBox PicPlay
AutoRedraw = -1 'True
BackColor = &H00000000&
FillColor = &H0000FFFF&
FillStyle = 0 'Solid
ForeColor = &H00000000&
Height = 4560
Left = 120
ScaleHeight = 19
ScaleMode = 0 'User
ScaleWidth = 14
TabIndex = 0
Top = 120
Width = 3360
End
Begin VB.Label lblLinesKilled
Alignment = 2 'Center
BackColor = &H00FFC0C0&
BorderStyle = 1 'Fixed Single
Caption = "0"
BeginProperty Font
Name = "华文楷体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF00FF&
Height = 312
Left = 3660
TabIndex = 5
Top = 1800
Width = 792
End
Begin VB.Label lblLevel
Alignment = 2 'Center
BackColor = &H00FFC0C0&
BorderStyle = 1 'Fixed Single
Caption = "初级"
BeginProperty Font
Name = "华文楷体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF00FF&
Height = 312
Left = 3660
TabIndex = 4
Top = 1380
Width = 792
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 Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdStart_Click()
PicPlay.SetFocus
If cmdStart.Caption = "开始(&S)" Then
cmdStart.Caption = "暂停(&S)"
Me.Caption = gstrAppName & "--正在运行"
Timer1.Enabled = True
gblnPaused = False
If cmdStop.Enabled = False Then '开始新游戏.
cmdStop.Enabled = True
Call NewCurShape
End If
Else '暂停游戏.
cmdStart.Caption = "开始(&S)"
Timer1.Enabled = False
Me.Caption = gstrAppName & "--暂停"
gblnPaused = True
End If
End Sub
Private Sub cmdStop_Click()
PicPlay.SetFocus
Call ResetEnv
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If (gblnPaused = True Or cmdStop.Enabled = False) And (KeyCode <> vbKeySpace) Then Exit Sub
Select Case KeyCode
Case vbKeyDown
If CanMoveDown Then '如方块可下移
'Call MovingSound
Call MoveDown '令方块下移
Call KillLine '消除所有完整的一行.
Else
'在gintBoard即Play view的与当前方块重叠的地方标记为已填充.
Dim i As Integer, j As Integer
Call TouchBottomSound
For i = 0 To 3
For j = 0 To 3
If gintCurShapeY + j <= UBound(gintBoard, 2) Then
If gintCurShape(i, j) = 1 Then
gintBoard(gintCurShapeX + i, gintCurShapeY + j) = 1
End If
End If
Next j
Next i
Call NewCurShape '显现新方块.
End If
Case vbKeyLeft
'Call MovingSound
If CanMoveLeft Then Call MoveLeft
Case vbKeyRight
'Call MovingSound
If CanMoveRight Then Call MoveRight
Case vbKeyUp
If CanRotateShape Then
Dim lngOldColor As Long
Call RotatingSound
'擦除当前方块所在区域.
lngOldColor = frmMain!PicPlay.FillColor
frmMain!PicPlay.FillColor = frmMain!PicPlay.BackColor
Call DrawCurShape
'旋转当前方块.
Call RotateShape(gintCurShape())
'在新位置重画.
frmMain!PicPlay.FillColor = lngOldColor '恢复原色.
Call DrawCurShape
End If
Case vbKeySpace
Call cmdStart_Click
End Select
End Sub
Private Sub Form_Load()
Randomize Timer
Call InitShapes '生成7种形状的方块.
gstrAppName = "俄罗斯方块"
Call ResetEnv
Call InitMMCs '初始化各MMC.
End Sub
Private Sub Form_Unload(Cancel As Integer)
MMC1.Command = "Close"
End Sub
Private Sub Timer1_Timer()
SendKeys "{DOWN}"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -