| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 2889 人关注过本帖, 1 人收藏
标题:自己写的俄罗斯方块
只看楼主 加入收藏
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
结帖率:100%
收藏(1)
 问题点数:0 回复次数:19 
自己写的俄罗斯方块
已知BUG:
1、在方块未出之前,按住方向键,左或右,会造成该块方块丢失。原因是坐标溢出。
2、旋转过程中,没有进行判断,存在无法旋转时,进行了旋转。

程序代码:
Option Explicit

Const 格子大小 = 450
Const 颜色最大值 = 16777215
Const 格子线 = 8421504

Dim 数据区(11, 21) As Long

Dim 方块(1 To 4, 1 To 4) As Long
'Dim 方块定义(1 To 4, 1 To 4, 7) As Long
Dim 方块定义(7) As String                   '用字符串保存方块定义
Dim NEX方块(1 To 4, 1 To 4) As Long

Dim 游戏状态 As Long                    '=0 表示游戏结束
Dim 得分 As Long

Dim FX As Long, FY As Long


Private Sub Command1_Click()
Dim i As Long, j As Long

'清除数据区
For i = 1 To 10
    For j = 1 To 20
        数据区(i, j) = 0
    Next j
Next i

'置状态
游戏状态 = 1
得分 = 0
Label1.Caption = 得分
    
'置初始方块及显示
    FX = 3
    FY = -3
'Call 初始化方块(方块(), 方块定义(Int(Rnd() * 7 + 1)), Int(Rnd() * 颜色最大值))
Call 新方块(方块())
Call 刷新

'置下一个方块
'Call 初始化方块(NEX方块(), 方块定义(Int(Rnd() * 7 + 1)), Int(Rnd() * 颜色最大值))
Call 新方块(NEX方块())
Call 显示方块(Picture2, NEX方块(), 4, 4, 345)

Label2.Visible = False

'设置焦点在图片框,可以接收KEYDOWN
Picture1.SetFocus


End Sub

Public Sub 显示方块(对象 As PictureBox, 数据() As Long, 宽 As Long, 高 As Long, 大小 As Long)

Const 空格 = 30             '2像素
Dim i As Long
Dim j As Long

对象.Cls                    '先清掉原来的
'画格子线
For i = 1 To 宽 + 1
    对象.Line (i * 大小 - 大小, 0)-(i * 大小 - 大小, 高 * 大小), 格子线
Next i
For i = 1 To 高 + 1
    对象.Line (0, i * 大小 - 大小)-(宽 * 大小, i * 大小 - 大小), 格子线
Next i

'扫描数据区,并根据数据区来画方块.
'如果预定义了图案,也可以在这里复制图案的方式进行组合成方块
For i = 1 To 宽
    For j = 1 To 高
        If 数据(i, j) > 0 Then
            对象.Line (i * 大小 - 大小 + 空格, j * 大小 - 大小 + 空格)-(i * 大小 - 空格, j * 大小 - 空格), 数据(i, j), BF
        End If
        'debug
'                对象.CurrentX = i * 大小 - 大小 + 空格
'                对象.CurrentY = j * 大小 - 大小 + 空格
'                对象.Print i; j
    Next j
Next i
End Sub

Public Sub 显示移动方块(对象 As PictureBox, 大小 As Long)

Const 空格 = 30

Dim i As Long
Dim j As Long
    
Dim k1 As Long
Dim k2 As Long
    
    '显示操作的那个方块,并且根据左上角坐标进行修正
    For i = 1 To 4
        For j = 1 To 4
            If 方块(i, j) > 0 Then
                k1 = FX * 大小 + i * 大小 - 大小
                k2 = FY * 大小 + j * 大小 - 大小
                对象.Line (k1 - 大小 + 空格, k2 - 大小 + 空格)-(k1 - 空格, k2 - 空格), 方块(i, j), BF
            End If
        Next j
    Next i

End Sub




Private Sub Form_Load()

Dim i As Long

'生成边界,用于后面的判断
For i = 0 To 11
    数据区(i, 0) = 256
    数据区(i, 21) = 256
Next i

For i = 0 To 21
    数据区(0, i) = 256
    数据区(11, i) = 256
Next i

'7种方块定义. 4*4 ,一共 16 个字符 ,1表示有,0表示空
方块定义(1) = "0100010001000100"
方块定义(2) = "0100010001100000"
方块定义(3) = "0100010011000000"
方块定义(4) = "0000010011100000"
方块定义(5) = "0000011001100000"
方块定义(6) = "0000110001100000"
方块定义(7) = "0000011011000000"

Randomize Timer

Dim k As String
k = "游戏说明:" & vbCrLf
k = k & "方向键进行操作" & vbCrLf
k = k & "空格键暂停" & vbCrLf
Label3.Caption = k

End Sub

Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)

'处于游戏中,处理所有的键
If 游戏状态 = 1 Then

    Select Case KeyCode
        Case vbKeyUp
            Call 右旋转(方块())         '此处有BUG
        Case vbKeyDown
            If 能否移动(1) Then
                FY = FY + 1
                Call 刷新
            End If
        Case vbKeyLeft
            If 能否移动(2) Then
                FX = FX - 1
                Call 刷新
            End If
        Case vbKeyRight
            If 能否移动(3) Then
                FX = FX + 1
                Call 刷新
            End If
        Case vbKeySpace     '暂停
            游戏状态 = 3
            Label2.Visible = True
            Label2.Caption = "暂  停"
    End Select
ElseIf 游戏状态 = 3 Then            '处于暂停中,只处理空格键
    If KeyCode = vbKeySpace Then
        游戏状态 = 1
        Label2.Visible = False
    End If
End If

End Sub

Private Sub Picture1_Paint()
    '因为没有启用图片缓存,所以需要手动重绘图像
    Call 显示方块(Picture1, 数据区(), 10, 20, 格子大小)
    Call 显示移动方块(Picture1, 450)
End Sub

Public Sub 初始化方块(cs() As Long, 数据 As String, color As Long)
'把方块字符串数据转为 4*4 的数组数据
Dim i As Long, j As Long
For i = 1 To 4
    For j = 1 To 4
        If Mid(数据, i * 4 - 4 + j, 1) = 1 Then
            cs(i, j) = color
        Else
            cs(i, j) = 0
        End If
    Next j
Next i
        
End Sub

Private Sub Picture2_Paint()
    '刷新 next 方块
    Call 显示方块(Picture2, NEX方块(), 4, 4, 345)
End Sub

Public Sub 右旋转(dat() As Long)

'向右,顺时针旋转
Dim i As Long

i = dat(1, 1)
dat(1, 1) = dat(4, 1)
dat(4, 1) = dat(4, 4)
dat(4, 4) = dat(1, 4)
dat(1, 4) = i

i = dat(1, 2)
dat(1, 2) = dat(3, 1)
dat(3, 1) = dat(4, 3)
dat(4, 3) = dat(2, 4)
dat(2, 4) = i

i = dat(1, 3)
dat(1, 3) = dat(2, 1)
dat(2, 1) = dat(4, 2)
dat(4, 2) = dat(3, 4)
dat(3, 4) = i

i = dat(2, 2)
dat(2, 2) = dat(3, 2)
dat(3, 2) = dat(3, 3)
dat(3, 3) = dat(2, 3)
dat(2, 3) = i

End Sub


Public Function 能否移动(cs As Long) As Boolean
'cs 表示方向,1向下,2向左,3向右

Dim NX As Long, NY As Long
Select Case cs
    Case 1
        NX = FX
        NY = FY + 1
    Case 2
        NX = FX - 1
        NY = FY
    Case 3
        NX = FX + 1
        NY = FY
End Select

If NX < -4 Or NX > 10 Or NY < -4 Or NY > 20 Then
    能否移动 = False
    Exit Function
End If


Dim i As Long, j As Long

能否移动 = True
For i = 1 To 4
    For j = 1 To 4
        If 方块(i, j) > 0 Then      '存在方块
            If 能否移动 Then
                If FX + i - 1 < 11 And FX + i - 1 > 0 And FY + j - 1 > 0 And FY + j - 1 < 21 Then       '在坐标范围内
                    If 数据区(NX + i - 1, NY + j - 1) > 0 Then      '数据区有方块
                        能否移动 = False
                        Exit For
                    End If
                End If
            End If
        End If
    Next j
    If Not 能否移动 Then        '如果已经出了结果,不再查找了
        Exit For
    End If
Next i

End Function

Private Sub Timer1_Timer()

Dim i As Long
Dim j As Long

'如果游戏处于结束,则退出处理
If 游戏状态 = 0 Then
    Exit Sub
End If

'设置焦点在图片框,可以接收KEYDOWN
Picture1.SetFocus

'如果游戏是处于暂停,则退出处理
If 游戏状态 = 3 Then        '暂停
    Exit Sub
End If

'如果游戏处于消除行,则调用清除行
If 游戏状态 = 2 Then
    Call 清除行
Else
    '判断能否向下移动,如果能,就向下移动
    If 能否移动(1) Then
        FY = FY + 1
        Call 刷新
    Else
        '否则,如果FY<1表示方块还没出完就无法移动了,说明已经顶格了,游戏结束
        If FY < 1 Then
            游戏状态 = 0
            Label2.Caption = "游戏结束"
            Label2.Visible = True
        Else
    '        Stop
            '固定当前方块,把操作的那个方块写入到区域中去
            For i = 1 To 4
                For j = 1 To 4
                    If FX + i - 1 < 11 And FX + i - 1 > 0 And FY + j - 1 > 0 And FY + j - 1 < 21 Then
                        If 方块(i, j) > 0 Then
                            数据区(FX + i - 1, FY + j - 1) = 方块(i, j)
                        End If
                    End If
                    方块(i, j) = NEX方块(i, j)
                Next j
            Next i
            '搜索是否有整行,并计分
            Call 计分
            
            '产生新的方块
            FX = 3
            FY = -3
            Call 新方块(NEX方块())      '把下一个方块转为操作的那个方块
            Call 显示方块(Picture2, NEX方块(), 4, 4, 345)       '并产生一个新的方块
        End If
    End If
End If

End Sub

Public Sub 刷新()
    '分别调用显示整个区域和控制的那个方块
    Call 显示方块(Picture1, 数据区(), 10, 20, 450)
    Call 显示移动方块(Picture1, 450)
End Sub

Public Sub 计分()
Dim i As Long
Dim j As Long
Dim 整行 As Boolean
Dim js As Long

js = 0
For i = 1 To 20
    整行 = True
    For j = 1 To 10
        If 数据区(j, i) = 0 Then
            整行 = False
            Exit For
        End If
    Next j
    If 整行 Then
        js = js + 1
    End If
Next i

'如果有整行,则进行清除
If js > 0 Then
    游戏状态 = 2
    Call 清除行(True)
End If

'计分原则
Select Case js
    Case 1
        得分 = 得分 + 100
    Case 2
        得分 = 得分 + 300
    Case 3
        得分 = 得分 + 900
    Case 4
        得分 = 得分 + 1500
End Select
Label1.Caption = 得分

End Sub

Public Sub 清除行(Optional cs As Boolean = False)
Static 闪烁计数 As Long
    If cs Then
        闪烁计数 = 6
    End If
    
    闪烁计数 = 闪烁计数 - 1
    
Dim i As Long
Dim j As Long
Dim 整行 As Boolean
Dim k As Long

If 闪烁计数 > 0 Then

    '此节用来闪烁所有的整行
    k = Int(Rnd() * 颜色最大值)
    For i = 1 To 20
        整行 = True
        For j = 1 To 10
            If 数据区(j, i) = 0 Then
                整行 = False
                Exit For
            End If
        Next j
        If 整行 Then
            For j = 1 To 10
                数据区(j, i) = k
            Next j
        End If
    Next i
    
Else
    '此节用来清掉所有的整行
    For i = 1 To 20
        整行 = True
        For j = 1 To 10
            If 数据区(j, i) = 0 Then
                整行 = False
                Exit For
            End If
        Next j
        If 整行 Then
            For j = i To 2 Step -1
                For k = 1 To 10
                    数据区(k, j) = 数据区(k, j - 1)
                Next k
            Next j
            For k = 1 To 10
                数据区(k, 1) = 0
            Next k
        End If
    Next i
    游戏状态 = 1
End If

    Call 显示方块(Picture1, 数据区(), 10, 20, 450)

End Sub

Public Sub 新方块(dat() As Long)
Dim i As Long
Dim R1 As Long, G1 As Long, B1 As Long
Dim j As Long, k As Double
i = Int(Rnd() * 7 + 1)

'此节是为了保证产生的方块能看得清
k = 255
Do While k > 128
    R1 = Rnd() * 255
    G1 = Rnd() * 255
    B1 = Rnd() * 255
    k = 0.3 * R1 + 0.5 * G1 + 0.2 * B1
Loop
j = RGB(R1, G1, B1)

Call 初始化方块(dat(), 方块定义(i), j)

End Sub



方块.rar (4.56 KB)
收到的鲜花
  • 三断笛2009-09-24 21:44 送鲜花  49朵   附言:好文章
搜索更多相关主题的帖子: 俄罗斯方块 
2009-09-23 23:17
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
以前的代码丢了,临时写的。
看到论坛里,好像有2人要,就随手写了一个。

授人于鱼,不如授人于渔
早已停用QQ了
2009-09-23 23:18
zss427607
Rank: 1
等 级:新手上路
帖 子:124
专家分:3
注 册:2008-10-28
收藏
得分:0 
谢谢了  收下
2009-09-24 20:42
yuning017
Rank: 1
等 级:新手上路
帖 子:12
专家分:6
注 册:2009-9-11
收藏
得分:0 
有点意思  研究研究
2009-09-25 14:07
。神仙
Rank: 1
等 级:新手上路
帖 子:4
专家分:0
注 册:2009-9-25
收藏
得分:0 
楼猪,能留个联系QQ么? 希望你有时间的时候我能请教下你。我是刚学VB的。很多东西老师讲的都不是太明确。想找个网上的朋友,在业余时间指导下我。


我QQ:9550405
2009-09-25 22:22
yuanknight
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2008-5-8
收藏
得分:0 
谢谢楼主,下来学习一下。
2009-10-02 18:58
hellowql
Rank: 2
来 自:安徽 合肥
等 级:论坛游民
帖 子:40
专家分:12
注 册:2009-4-25
收藏
得分:0 
支持一下,很有才。
2009-10-02 19:20
dhy80801
Rank: 3Rank: 3
等 级:论坛游侠
帖 子:67
专家分:145
注 册:2008-12-14
收藏
得分:0 
……
2009-10-03 13:05
hb17908
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2009-10-8
收藏
得分:0 
好长的代码
2009-10-08 17:19
adadejia
Rank: 1
来 自:云南
等 级:新手上路
帖 子:12
专家分:0
注 册:2009-2-26
收藏
得分:0 
好玩`
2009-10-13 19:04
快速回复:自己写的俄罗斯方块
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.036661 second(s), 11 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved