vb俄罗斯方块程序代码 下载本文

内容发布更新时间 : 2024/5/19 15:48:41星期一 下面是文章的全部内容请认真阅读。

Dim i As Integer, j As Integer For i = 3 To 0 Step -1 '测试是否落到底

For j = 0 To 3

If blnBlock(intTypeCur, intOrieCur, i, j) And (i + intYCur >= 19) Then Exit For '超出下边界

If Not (i + intYCur + 1 < 0 Or i + intYCur + 1 > 19 Or j + intXCur < 0 Or j + intXCur > 9) Then '如果下边遇到方块

If blnBlock(intTypeCur, intOrieCur, i, j) And (blnGrid(i + intYCur + 1, j + intXCur)) Then

Exit For End If End If Next

If j <= 3 Then Exit For Next

If i >= 0 Then '如果方块已落到底 If intYCur <= -1 Then '本轮已结果 Timer1.Enabled = False

If lngScore > lngHighScore Then lngHighScore = lngScore txtHigh.Text = lngHighScore End If

lngScore = 0 txtScore.Text = 0 Randomize

blnStarted = True

intTypeCur = Int(Rnd * 5) '随机出现方块与下一个方块 lngColorCur = QBColor(Int(Rnd * 14))

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 * 14)) Erase blnGrid, lngColor lblstart.Caption = \开 始\ Call Form_Activate

Else

For i = 0 To 3 For j = 0 To 3

If Not (i + intYCur < 0 Or i + intYCur > 19 Or j + intXCur < 0 Or j + intXCur > 9) Then '避免出现下标越界

If blnBlock(intTypeCur, intOrieCur, i, j) Then blnGrid(i + intYCur, j + intXCur) = True

lngColor(i + intYCur, j + intXCur) = lngColorCur End If End If Next Next

Randomize

intTypeCur = intTypeNew

intTypeNew = Int(Rnd * 5) lngColorCur = lngColorNew

lngColorNew = QBColor(Int(Rnd * 7)) intOrieCur = intOrieNew intOrieNext = intOrieNew

intOrieNew = Int(Rnd * 4)

intYCur = -3: intXCur = 2 intYNext = intYCur: intXNext = intXCur

intTypeNew = Int(Rnd * 5) 块与颜色

intOrieNew = Int(Rnd * 4)

lngColorNew = QBColor(Int(Rnd * 7))

Call Score

Call ShowBlock

Call ShowNext End If Else

intYNext = intYNext + 1 Call ShowBlock End If End Sub

Private Sub GoLeft()

Dim i As Integer, j As Integer

For i = 0 To 3

'随机出现下一个方块 '随机出现下一个方块的颜色 '随机决定方块方位 '方块出现时的位置 '随机产生下个方块的类型,方 '显示下一个方块类型 For j = 0 To 3

If blnBlock(intTypeCur, intOrieCur, j, i) And i + intXCur <= 0 Then Exit Sub '禁止超出左边界 Next Next

intXNext = intXNext - 1

End Sub

Private Sub GoRight()

Dim i As Integer, j As Integer

For i = 3 To 0 Step -1 For j = 0 To 3

If blnBlock(intTypeCur, intOrieCur, j, i) And i + intXCur >= 9 Then Exit Sub '禁止超出右边界 Next Next

intXNext = intXNext + 1

End Sub

Private Sub Rotate() '旋转 Dim i As Integer, j As Integer Dim intTempNext As Integer

If blnClockWise Then '临时产生下一个方位,检测是否超出范围,或重叠

intTempNext = intOrieNext - 1

If intTempNext = -1 Then intTempNext = 3 Else

intTempNext = intOrieNext + 1

If intTempNext = 4 Then intTempNext = 0 End If

For i = 3 To 0 Step -1 For j = 0 To 3

If blnBlock(intTypeCur, intTempNext, j, i) And i + intXCur > 9 Then Exit Sub '禁止超出右边界

If blnBlock(intTypeCur, intTempNext, j, i) And i + intXCur < 0 Then Exit Sub '禁止超出左边界

If blnBlock(intTypeCur, intTempNext, j, i) And j + intYCur > 19 Then Exit Sub '禁止超出下边界

If blnBlock(intTypeCur, intTempNext, j, i) And j + intYCur < 0 Then Exit Sub '禁止超出上边界

If j + intYCur >= 0 And j + intYCur <= 19 And i + intXCur >= 0 And i + intXCur <= 9 Then

If blnBlock(intTypeCur, intTempNext, j, i) And blnGrid(j + intYCur, i + intXCur) Then Exit Sub '禁止重叠 End If Next Next

intOrieCur = intOrieNext intOrieNext = intTempNext ' intOrieNext = intOrieNext - 1

' If intOrieNext = -1 Then intOrieNext = 3 End Sub

Private Sub QuickDown()

Dim i As Integer, j As Integer, k As Integer Do

For i = 3 To 0 Step -1 For j = 0 To 3

If blnBlock(intTypeCur, intOrieCur, i, j) And (i + intYCur + k >= 19) Then Exit For '超出下边界

If Not (i + intYCur + 1 + k < 0 Or i + intYCur + 1 + k > 19 Or j + intXCur < 0 Or j + intXCur > 9) Then '如果下边遇到方块

If blnBlock(intTypeCur, intOrieCur, i, j) And (blnGrid(i + intYCur + 1 + k, j + intXCur)) Then

Exit For End If End If Next

If j <= 3 Then Exit For Next

If i >= 0 Then Exit Do

If k = intDownDistance Then Exit Do

k = k + 1 Loop

intYNext = intYNext + k Call ShowBlock

End Sub

Private Sub Score()

Dim i As Integer, j As Integer, k As Integer, num As Integer

For i = 19 To 0 Step -1 For j = 0 To 9

If Not blnGrid(i, j) Then Exit For Next

If j > 9 Then

num = num + 1

For k = i To 1 Step -1 For j = 0 To 9

blnGrid(k, j) = blnGrid(k - 1, j) lngColor(k, j) = lngColor(k - 1, j) Next Next k = 0

For j = 0 To 9

blnGrid(k, j) = False lngColor(k, j) = False Next i = i + 1 End If Next

If num > 0 Then

Select Case num Case 1

lngScore = lngScore + 100 Case 2

lngScore = lngScore + 300 Case 3

lngScore = lngScore + 700 Case 4

lngScore = lngScore + 1500 End Select

txtScore.Text = lngScore

txtSpeed = lngScore \\ 2000 + 1

Timer1.Interval = 300 - txtSpeed * 27 Call Form_Activate End If End Sub

Private Sub ShowNext()

Dim i As Integer, j As Integer If blnShowNext Then For i = 0 To 3 For j = 0 To 3

If blnBlock(intTypeNew, intOrieNew, i, j) Then