📄 form1.frm
字号:
FontName = "宋体"
FontEffects = 1073750016
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin MSForms.CommandButton BlockPreview
Height = 255
Index = 3
Left = 735
TabIndex = 14
Top = 15
Visible = 0 'False
Width = 255
VariousPropertyBits= 25
Size = "450;450"
FontName = "宋体"
FontEffects = 1073750016
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin MSForms.CommandButton BlockPreview
Height = 255
Index = 2
Left = 495
TabIndex = 13
Top = 15
Visible = 0 'False
Width = 255
VariousPropertyBits= 25
Size = "450;450"
FontName = "宋体"
FontEffects = 1073750016
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin MSForms.CommandButton BlockPreview
Height = 255
Index = 1
Left = 255
TabIndex = 12
Top = 15
Visible = 0 'False
Width = 255
VariousPropertyBits= 25
Size = "450;450"
FontName = "宋体"
FontEffects = 1073750016
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin MSForms.CommandButton BlockPreview
Height = 255
Index = 0
Left = 15
TabIndex = 11
Top = 15
Visible = 0 'False
Width = 255
VariousPropertyBits= 25
Size = "450;450"
FontName = "宋体"
FontEffects = 1073750016
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
End
Begin VB.Label LabNext
BackStyle = 0 'Transparent
Caption = "下一块:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000040C0&
Height = 270
Left = 2955
TabIndex = 36
Top = 75
Width = 1050
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "得分"
Height = 195
Left = 2895
TabIndex = 5
Top = 2325
Width = 375
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "等级"
Height = 195
Left = 2895
TabIndex = 7
Top = 1965
Width = 375
End
Begin VB.Label LabelLevel
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 315
Left = 3315
MousePointer = 4 'Icon
TabIndex = 6
Top = 1905
Width = 675
End
Begin VB.Label LabelScore
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 315
Left = 3315
TabIndex = 4
Top = 2265
Width = 675
End
Begin VB.Menu MnuFile
Caption = "文件(&F)"
Begin VB.Menu cmdStart
Caption = "开始(&Start)"
Shortcut = {F2}
End
Begin VB.Menu dot
Caption = "-"
End
Begin VB.Menu cmdexit
Caption = "退出(&Exit)"
Shortcut = {F5}
End
End
Begin VB.Menu cmdSetting
Caption = "设置(&S)"
End
Begin VB.Menu CmdPause
Caption = "暂停(&P)"
Enabled = 0 'False
End
Begin VB.Menu about
Caption = "关于(&A)"
Begin VB.Menu cmdhelp
Caption = "帮助(&Help)"
Shortcut = {F1}
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub AniGif1_Click()
EMAIL_ME
End Sub
Private Sub AniGif2_Click()
GOHOMEPAGE
End Sub
Private Sub CmdDown_Click()
Dim i As Integer, tmpColor As Long
If CheckMovable(vbMoveDown) Then
tmpColor = Block(MovingBlock(1)).BackColor
For i = 1 To 4
BlockData(MovingBlock(i)) = 0
Block(MovingBlock(i)).Visible = False
MovingBlock(i) = MovingBlock(i) + Row10
Next
For i = 1 To 4
Block(MovingBlock(i)).Visible = True
Block(MovingBlock(i)).BackColor = tmpColor
BlockData(MovingBlock(i)) = 1
Next
Else
'''''''''''''''''''''''Kill a line
KillALine
If GeneralANewBlock = False Then YouDie
End If
iCount = 0
End Sub
Private Sub Cmdexit_Click()
If MsgBox("确认要退出吗？", vbOKCancel + vbInformation, "确认吗？") = vbOK Then Unload Me
End Sub
Private Sub CmdHelp_Click()
Timer1.Interval = 0
frmAbout.Show 1
End Sub
Private Sub CmdLeft_Click()
Dim i As Integer, tmpColor As Long
If CheckMovable(vbMoveLeft) Then
tmpColor = Block(MovingBlock(1)).BackColor
For i = 1 To 4
BlockData(MovingBlock(i)) = 0
Block(MovingBlock(i)).Visible = False
MovingBlock(i) = MovingBlock(i) - 1
Next
For i = 1 To 4
Block(MovingBlock(i)).Visible = True
Block(MovingBlock(i)).BackColor = tmpColor
BlockData(MovingBlock(i)) = 1
Next i
'''''''''''''''''''''''''''''''''''''''
'''''''''''''''''若能移动则icount还原
'''''''''''''''''否则不变
End If
End Sub
Private Sub CmdPause_Click()
If CmdLeft.Enabled = False Then
Timer1.Interval = 1
CmdLeft.Enabled = True
CmdRight.Enabled = True
CmdRevert.Enabled = True
CmdDown.Enabled = True
CmdPause.Caption = "暂停(&P)"
Else
Timer1.Interval = 0
CmdLeft.Enabled = False
CmdRight.Enabled = False
CmdRevert.Enabled = False
CmdDown.Enabled = False
CmdPause.Caption = "继续(&P)"
End If
End Sub
Private Sub CmdRevert_Click()
If CheckMovable(vbRevert) = False Then Exit Sub
Dim tempArray(2 To 4) As Integer, tmp As Integer, i As Integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''已经确认可以旋转了
For i = 1 To 4
Block(MovingBlock(i)).Visible = False
Next i
For i = 2 To 4
tmp = MovingBlock(i) - MovingBlock(1)
If tmp > -4 And tmp < 4 Then '''''''''''''''''''在同一行，变成同一列
tempArray(i) = MovingBlock(i) + tmp * (Row10 - 1)
ElseIf Abs(tmp) = (Row10 - 1) Or Abs(tmp) = (Row10 + 1) Then
''''''''''''''''''''''''''''''''''''''''''''''''''在斜对位置
Select Case tmp
Case -Row10 - 1
tempArray(i) = MovingBlock(1) - Row10 + 1
Case 1 - Row10
tempArray(i) = MovingBlock(1) + Row10 + 1
Case Row10 - 1
tempArray(i) = MovingBlock(1) - Row10 - 1
Case Row10 + 1
tempArray(i) = MovingBlock(1) + Row10 - 1
End Select
Else ''''''''''''''''''''''''''''''''''''''''''''在同一列，变成同一行
tempArray(i) = MovingBlock(i) - tmp \ Row10 - tmp
''''''''''''''''''''''可能在最顶端或最底端
End If
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''在这里旋转
'''''''''''''''''''''尽量让它更新快点
Dim tmpColor As Long
tmpColor = Block(MovingBlock(1)).BackColor
For i = 2 To 4
BlockData(MovingBlock(i)) = 0
MovingBlock(i) = tempArray(i)
BlockData(MovingBlock(i)) = BlockData(MovingBlock(1))
Block(MovingBlock(i)).BackColor = tmpColor
Next i
For i = 1 To 4
Block(MovingBlock(i)).Visible = True
Next i
'''''''''''''''''''''''''''''''''''''''''''''''在这里旋转
Picture1.SetFocus
End Sub
Private Sub CmdRight_Click()
Dim i As Integer, tmpColor As Long
If CheckMovable(vbMoveRight) Then
tmpColor = Block(MovingBlock(1)).BackColor
For i = 1 To 4
BlockData(MovingBlock(i)) = 0
Block(MovingBlock(i)).Visible = False
MovingBlock(i) = MovingBlock(i) + 1
Next
For i = 1 To 4
Block(MovingBlock(i)).Visible = True
Block(MovingBlock(i)).BackColor = tmpColor
BlockData(MovingBlock(i)) = 1
Next i
'''''''''''''''''''''''''''''''''''''''
'''''''''''''''''若能移动则icount还原
'''''''''''''''''否则不变
End If
End Sub
Private Sub CmdSetting_Click()
Timer1.Interval = 0
Load Form2
Form2.Show 1
End Sub
Private Sub cmdstart_click()
cmdStart.Caption = "从新开始(&Restart)"
GeneralNewGame LastRow, LastCol
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF3 Then
CmdSetting_Click
Exit Sub
ElseIf KeyCode = vbKeyEscape Then
WindowState = 1
Exit Sub
End If
Select Case KeyCode
Case vbMoveLeft
If CmdLeft.Enabled = False Then Exit Sub
CmdLeft_Click
Case vbMoveRight
If CmdLeft.Enabled = False Then Exit Sub
CmdRight_Click
Case vbMoveDown
If CmdLeft.Enabled = False Then Exit Sub
Dim tmpMyScore As Integer
tmpMyScore = LabelScore.Caption
While (tmpMyScore = MyScore)
CmdDown_Click
Wend
Case vbStepDown
CmdDown_Click
Case vbRevert
If CmdLeft.Enabled = False Then Exit Sub
CmdRevert_Click
Case vbKeyPause, vbKeyF4
If LastRow = 0 Then Exit Sub
CmdPause.Enabled = True
CmdPause_Click
End Select
End Sub
Private Sub Form_Load()
BlockColor(0) = vbWhite
BlockColor(1) = vbRed
BlockColor(2) = vbGreen
BlockColor(3) = vbBlue
BlockColor(4) = vbYellow
BlockColor(5) = vbCyan
BlockColor(6) = vbMagenta
'''''''''''''''''''''''''''''''''''''''''''
If Right(App.Path, 1) = "\" Then
AppFilePath = App.Path
Else
AppFilePath = App.Path & "\"
End If
AppFilePath = AppFilePath & "Data\"
sndupGrade = AppFilePath & "upgrade.wav"
sndDown = AppFilePath & "Down.wav"
sndKillLine = AppFilePath & "Killline.wav"
sndDie = AppFilePath & "Die.wav"
''''''''''''''''''''''''''''''''''''''''''''''''''''''
'AniGif1.FileName = AppFilePath & "email.gif"
'AniGif2.FileName = AppFilePath & "homepage.gif"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Row10 = 10
Col20 = 25
MyLevel = 1
StartLevel = 1
UpgradeFrequence = 1000
LastRow = 0
LastCol = 0
vbMoveLeft = vbKeyLeft
vbMoveRight = vbKeyRight
vbMoveDown = vbKeyDown
vbRevert = vbKeyUp
vbStepDown = vbKeyNumpad0
Randomize
End Sub
Private Sub Form_Resize()
Select Case WindowState
Case 0
If Row10 <> 0 Then
If CmdLeft.Enabled = True Then Timer1.Interval = 1
End If
Case 1
Timer1.Interval = 0
End Select
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer
If LastRow <> 0 Then
For i = 1 To Row10 * Col20 - 1
Unload Block(i)
Next
End If
End Sub
Private Sub Timer1_Timer()
iCount = iCount + 1
If iCount = 10 - MyLevel Then
iCount = 0
CmdDown_Click
End If
End Sub
Public Sub YouDie()
dialog.Show 1
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -