内容发布更新时间 : 2024/5/22 0:39:16星期一 下面是文章的全部内容请认真阅读。
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
intYCur = intYNext intXCur = intXNext
intOrieCur = intOrieNext End Sub
Private Sub Form_Activate()
Dim i As Integer, j As Integer '绘制表格与已有的堆积方块 For i = 0 To 19 For j = 0 To 9
If blnGrid(i, j) Then
picGrid.Line (j * 20 + 2, i * 20 + 2)-(j * 20 + 19, i * 20 + 19), lngColor(i, j), B picGrid.Line (j * 20 + 4, i * 20 + 4)-(j * 20 + 17, i * 20 + 17), lngColor(i, j), BF
Else
picGrid.Line (j * 20 + 2, i * 20 + 2)-(j * 20 + 19, i * 20 + 19), vbBlack, B picGrid.Line (j * 20 + 4, i * 20 + 4)-(j * 20 + 17, i * 20 + 17), vbWhite, BF End If Next Next
'绘制“下一个”网块
For i = 0 To 3 For j = 0 To 3
picNext.Line (j * 20 + 2, i * 20 + 2)-(j * 20 + 19, i * 20 + 19), vbBlack, B Next Next
'初次启动时不显示下一个和移动方块 If blnStarted Then
If blnShowNext Then For i = 0 To 3 For j = 0 To 3
If blnBlock(intTypeNew, intOrieNew, i, j) Then
picNext.Line (j * 20 + 2, i * 20 + 2)-(j * 20 + 19, i * 20 + 19), lngColorNew, B
picNext.Line (j * 20 + 4, i * 20 + 4)-(j * 20 + 17, i * 20 + 17), lngColorNew, BF
Else
picNext.Line (j * 20 + 2, i * 20 + 2)-(j * 20 + 19, i * 20 + 19), vbBlack, B
picNext.Line (j * 20 + 4, i * 20 + 4)-(j * 20 + 17, i * 20 + 17), vbWhite, BF
End If Next Next Else
For i = 0 To 3 For j = 0 To 3
picNext.Line (j * 20 + 2, i * 20 + 2)-(j * 20 + 19, i * 20 + 19), vbBlack, B picNext.Line (j * 20 + 4, i * 20 + 4)-(j * 20 + 17, i * 20 + 17), vbWhite, BF
Next Next End If
Call ShowBlock End If End Sub
Private Sub form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then If Not blnStarted Then Call lblStart_Click Exit Sub
End If
If Timer1.Enabled Then Timer1.Enabled = False lblstart.Caption = \继 续\ Exit Sub Else
Timer1.Enabled = True lblstart.Caption = \暂 停\ Exit Sub End If End If
If Not Timer1.Enabled Then Exit Sub If blnScheme Then
Select Case KeyCode Case vbKeyLeft GoLeft
Case vbKeyRight GoRight Case vbKeyUp Rotate
Case vbKeyDown '加速下降 QuickDown End Select Else
Select Case KeyCode Case Asc(\ GoLeft Case Asc(\ GoRight Case Asc(\ Rotate
Case Asc(\ '加速下降 QuickDown End Select End If
Call ShowBlock End Sub
Private Sub Form_Unload(Cancel As Integer)
Open App.Path & \
Write #1, intDownDistance, blnClockWise, blnShowNext, blnScheme, lngHighScore Close 1 End Sub
Private Sub lblStart_Click() If Not blnStarted Then Randomize
blnStarted = True
intTypeCur = Int(Rnd * 5) '随机出现方块与下一个方块 lngColorCur = QBColor(Int(Rnd * 7))
intOrieCur = Int(Rnd * 4) '随机决定方块方位 intOrieNext = intOrieCur
intYCur = -3: intXCur = 2 intYNext = intYCur: intXNext = intXCur
intTypeNew = Int(Rnd * 5) 色
intOrieNew = Int(Rnd * 4)
lngColorNew = QBColor(Int(Rnd * 7))
Call ShowBlock Call ShowNext End If
Timer1.Enabled = Not Timer1.Enabled If Timer1.Enabled Then
lblstart.Caption = \暂 停\ Else
lblstart.Caption = \继 续\ End If
End Sub
Private Sub mnuExit_Click() Unload Me End Sub
Private Sub mnuOption_Click() Timer1.Enabled = False lblstart.Caption = \继 续\ frmOption.Show 1, Me End Sub
Private Sub Timer1_Timer()
'方块出现时的位置 '随机产生下个方块的类型,方块与颜