| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 994 人关注过本帖
标题:俄罗斯方块
只看楼主 加入收藏
youshuling520
Rank: 1
等 级:新手上路
帖 子:24
专家分:0
注 册:2008-5-25
收藏
 问题点数:0 回复次数:9 
俄罗斯方块
那位高手有VB.nt做的俄罗斯方块的代码呀???
搜索更多相关主题的帖子: 俄罗斯方块 代码 
2008-05-29 23:03
flyue
Rank: 10Rank: 10Rank: 10
来 自:江南西道
等 级:贵宾
威 望:19
帖 子:3465
专家分:1563
注 册:2006-6-20
收藏
得分:0 
网络上多的是,你去“www.”看看

天之道,损有余而补不足.人之道则不然,损不足以奉有余.孰能有余以奉天下,唯有道者.
2008-05-30 13:36
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
Option Explicit
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Dim SpeedTemp As Long

Private Sub Command1_Click()
    If Command1.Caption = "开始游戏" Then
        Command1.Caption = "重新开始"
        Call StartGame
    Else
        speed = 1: Text1.Item(1) = 1
        total = 0: Text1.Item(0) = 0
        Text1.Item(2) = max
        Call StartGame
    End If
End Sub


Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim i As Integer
    If True = TopToBottom.Enabled Then
        Select Case KeyCode
        Case vbKeyLeft
            Call fk_Left
        Case vbKeyUp
            Call fk_Change
        Case vbKeyRight
            Call fk_Right
        Case vbKeyDown
            If TopToBottom.Interval <> 20 Then SpeedTemp = TopToBottom.Interval
            TopToBottom.Interval = 20
        End Select
    End If

    If starting = False Then
        Select Case KeyCode
        Case vbKeyPageDown
            If Text1.Item(1) > 1 Then
                SpeedTemp = SpeedTemp + 70
                Text1.Item(1) = Text1.Item(1) - 1
                speed = speed - 1
            End If
        Case vbKeyPageUp
             If Text1.Item(1) < 9 Then
                SpeedTemp = SpeedTemp - 70
                Text1.Item(1) = Text1.Item(1) + 1
                speed = speed + 1
             End If
        End Select
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If True = starting And vbKeyDown = KeyCode Then
         TopToBottom.Interval = SpeedTemp
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call save
End Sub

Private Sub nmexit_Click()
    If MsgBox("确定退出游戏", vbQuestion + vbYesNo, Me.Caption) = vbYes Then
        Unload Me
    End If
End Sub

Private Sub nmhelp_Click()
  Dim Msg As String
  Msg = "键盘控制方法:" & vbCrLf
  Msg = Msg & "1.左右光标键控制方块左右移动;" & vbCrLf
  Msg = Msg & "2.上光标键控制方块顺时针旋转90度;" & vbCrLf
  Msg = Msg & "3.下光标键控制方块加速向下移动。" & vbCrLf
  Msg = Msg & "4.PageUp、PageDown调节开始速度。" & vbCrLf
  Msg = Msg & "-----------------------------------" & vbCrLf
  Msg = Msg & "          xlin制作 " & vbCrLf
  Msg = Msg & "  E-Mail: xlin1033@
  MsgBox Msg, vbOKOnly + vbQuestion, Me.Caption
End Sub

Private Sub form_Initialize()
   Dim i As Integer, j As Integer
   
   '开始结束标志
    starting = False: gameover = False
   
    '初始化工作
    Call InitGrid
    Call InitNextBox
   
    '初始化comctl32.dll,使应用程序支持WinXP界面风格
    Call InitCommonControls
   
    '初始化随即数
    Call Randomize
   
    '获取最高得分
    Call loadsave
   
    '产生一个方块
    Call Create_fk(Next_fk)
   
    '插入到小框架中
    Call InSertNext
   
    speed = 1
End Sub

Private Sub StartGame()
    Dim i As Long, j As Long
   
    '部分初始化工作
    Call loadsave
    total = 0
    TopToBottom.Interval = 610 - (speed - 1) * 70
    SpeedTemp = TopToBottom.Interval
    starting = True
    TopToBottom.Enabled = False
   
    '重新绘背景
    Call InitGrid
   
    '初始背景表格数据
    For i = 0 To CLine - 1
        For j = 0 To CCol - 1
            grid(i, j) = 0
        Next
    Next
   
    '开始产生方块
    GameTimer.Enabled = True
End Sub

Private Sub GameTimer_Timer()
   
    '先前产生的方块成为当前方块
    Call NextToNow
   
    '产生下一个方块
    Call Create_fk(Next_fk)
   
    '更新刚才产生的方块到小框架中
    Call InSertNext
   
    '当前方块插入网格中
    Call InSertGrid
   
    '加速下落以后重新还原速度
    TopToBottom.Interval = SpeedTemp
   
    '下落过程开始
     Call StartOfDown
End Sub

Public Sub TopToBottom_Timer()
    Call fk_Down '下落一格
End Sub


Private Sub StartOfDown()
    GameTimer.Enabled = False
    TopToBottom.Enabled = True
End Sub

Private Function loadsave()
    Dim a As Double
    Dim strTemp As String
On Error GoTo Errlab
    strTemp = App.Path & "\data.bin"
    Open strTemp For Binary As #1
    Get #1, 8, a
    Close #1
    frmMain.Text1.Item(2) = a
    max = a
    loadsave = True
Errlab:
End Function
还要一个模块:
Option Explicit

Private Type m_fk '方块的数据结构
    color As Long
    StartX As Single
    StartY As Single
    Data(3, 3) As Long
    ChangeType As Integer
    Kinds As Integer
    fk_Kind As Integer
End Type

Private Mcolor(1 To 13) As Long
Public Now_fk As m_fk '存储当前方块的信息
Public Next_fk As m_fk '存储下一个方块的信息
Public BoxWidth As Long  '格子的宽度
Public Const CLine As Long = 21   '行数
Public Const CCol As Long = 11    '列数
Public starting As Boolean, gameover As Boolean '游戏开始结束标志
Public max As Double '历史最高分数
Public speed As Long '游戏等级(速度)
Public total As Double '当前得分
Public grid(0 To CLine - 1, 0 To CCol - 1) As Long '网格数组,0表示没有方块,有数据表示有方块,数据为颜色值


Public Function InitGrid()
    Dim X As Single, i As Single, j As Single
   
    '初始化网格1
    frmMain.blackGrid.ScaleMode = 3   ' 设置 ScaleMode 为像素。
    frmMain.blackGrid.AutoRedraw = True
   
    frmMain.blackGrid.Line (0, 0)-(frmMain.blackGrid.ScaleWidth, frmMain.blackGrid.ScaleHeight), &H80000005, BF
    BoxWidth = frmMain.blackGrid.ScaleWidth / CCol
    For X = 0 To CCol
        frmMain.blackGrid.Line (X * BoxWidth, 0)-(X * BoxWidth, frmMain.blackGrid.ScaleHeight), &HFFC0C0, B
    Next
    For X = 0 To CLine
        frmMain.blackGrid.Line (0, X * BoxWidth)-(frmMain.blackGrid.ScaleWidth, X * BoxWidth), &HFFC0C0, B
    Next
   
    For i = 0 To CLine - 1
        For j = 0 To CCol - 1
            grid(i, j) = 0
            Call FillEveryOne(j * BoxWidth, i * BoxWidth, vbWhite)
        Next
    Next
   
    Mcolor(1) = &H8080&: Mcolor(2) = &H808000: Mcolor(3) = &H4080&
    Mcolor(4) = &H8000&: Mcolor(5) = &H80&: Mcolor(6) = &H800000
    Mcolor(7) = &H800080: Mcolor(8) = &HFF&: Mcolor(9) = &H80FF&
    Mcolor(10) = &H404080: Mcolor(11) = &HFF8080: Mcolor(12) = &HFF00FF
    Mcolor(13) = &HFF0000
End Function


Public Function Create_fk(ByRef m_Temp As m_fk, Optional Kind As Integer = 0, Optional ByVal X As Single = -1, Optional ByVal Y As Single = -1) As Boolean
    Dim color As Long
    Dim i As Integer, j As Integer
   
    On Error GoTo Errlab
   
    '初始化信息
    With m_Temp
        .color = 0
        .StartX = 0
        .StartY = 0
        For i = 0 To 3
            For j = 0 To 3
                .Data(i, j) = 0
            Next
        Next
        .ChangeType = 1
        .fk_Kind = 1
        .Kinds = 1
    End With
   
    '产生不同类型的方块
    If Kind = 0 Then
        m_Temp.Kinds = Int(Rnd * 7) + 1:
        m_Temp.color = Mcolor(Int(Rnd * 13) + 1)
        color = m_Temp.color
        Select Case m_Temp.Kinds
        Case 1: m_Temp.fk_Kind = Int(Rnd * 2) + 1
        Case 2: m_Temp.fk_Kind = 1
        Case 3: m_Temp.fk_Kind = Int(Rnd * 2) + 1
        Case 4: m_Temp.fk_Kind = Int(Rnd * 2) + 1
        Case 5: m_Temp.fk_Kind = Int(Rnd * 4) + 1
        Case 6: m_Temp.fk_Kind = Int(Rnd * 4) + 1
        Case 7: m_Temp.fk_Kind = Int(Rnd * 4) + 1
        End Select
    Else
        m_Temp.Kinds = Kind
        m_Temp.color = Now_fk.color: color = m_Temp.color
        m_Temp.fk_Kind = Now_fk.fk_Kind + 1
        If m_Temp.fk_Kind > Now_fk.ChangeType Then m_Temp.fk_Kind = 1
    End If
   
    Select Case m_Temp.Kinds
    Case 1 '直条
        m_Temp.ChangeType = 2
        If m_Temp.fk_Kind = 1 Then '|
            m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -3 * BoxWidth
            m_Temp.Data(1, 0) = color: m_Temp.Data(1, 1) = color
            m_Temp.Data(1, 2) = color: m_Temp.Data(1, 3) = color
            m_Temp.fk_Kind = 1
        Else '———
            m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
            m_Temp.Data(0, 2) = color: m_Temp.Data(1, 2) = color
            m_Temp.Data(2, 2) = color: m_Temp.Data(3, 2) = color
            m_Temp.fk_Kind = 2
        End If
    Case 2 '方块
            m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
            m_Temp.ChangeType = 1: m_Temp.fk_Kind = 1
            m_Temp.Data(1, 1) = color: m_Temp.Data(1, 2) = color
            m_Temp.Data(2, 1) = color: m_Temp.Data(2, 2) = color
    Case 3 'S型
        m_Temp.ChangeType = 2
        If m_Temp.fk_Kind = 1 Then
            m_Temp.StartX = 5 * BoxWidth: m_Temp.StartY = -1 * BoxWidth
            m_Temp.Data(1, 0) = color: m_Temp.Data(2, 0) = color
            m_Temp.Data(0, 1) = color: m_Temp.Data(1, 1) = color
            m_Temp.fk_Kind = 1
        Else '|
            m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
            m_Temp.Data(0, 0) = color: m_Temp.Data(0, 1) = color
            m_Temp.Data(1, 1) = color: m_Temp.Data(1, 2) = color
            m_Temp.fk_Kind = 2
        End If
    Case 4 'Z型
        m_Temp.ChangeType = 2
        If m_Temp.fk_Kind = 1 Then '|
            m_Temp.StartX = 5 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
            m_Temp.Data(0, 1) = color: m_Temp.Data(0, 2) = color
            m_Temp.Data(1, 0) = color: m_Temp.Data(1, 1) = color
            m_Temp.fk_Kind = 1
        Else
            m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -1 * BoxWidth
            m_Temp.Data(0, 0) = color: m_Temp.Data(1, 0) = color
            m_Temp.Data(1, 1) = color: m_Temp.Data(2, 1) = color
            m_Temp.fk_Kind = 2
        End If
    Case 5 'J型
        m_Temp.ChangeType = 4
        Select Case m_Temp.fk_Kind
        Case 1 '|
            m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
            m_Temp.Data(2, 0) = color: m_Temp.Data(1, 0) = color
            m_Temp.Data(1, 1) = color: m_Temp.Data(1, 2) = color
            m_Temp.fk_Kind = 1
        Case 2
            m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
            m_Temp.Data(0, 1) = color: m_Temp.Data(1, 1) = color
            m_Temp.Data(2, 1) = color: m_Temp.Data(2, 2) = color
            m_Temp.fk_Kind = 2
        Case 3
            m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
            m_Temp.Data(1, 0) = color: m_Temp.Data(1, 1) = color
            m_Temp.Data(1, 2) = color: m_Temp.Data(0, 2) = color
            m_Temp.fk_Kind = 3
        Case 4
            m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -1 * BoxWidth
            m_Temp.Data(0, 0) = color: m_Temp.Data(0, 1) = color
            m_Temp.Data(1, 1) = color: m_Temp.Data(2, 1) = color
            m_Temp.fk_Kind = 4
        End Select
    Case 6 'L型
        m_Temp.ChangeType = 4
        Select Case m_Temp.fk_Kind
        Case 1
            m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -1 * BoxWidth
            m_Temp.Data(0, 1) = color: m_Temp.Data(1, 1) = color
            m_Temp.Data(2, 1) = color: m_Temp.Data(2, 0) = color
            m_Temp.fk_Kind = 1
        Case 2 '|
            m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
            m_Temp.Data(1, 0) = color: m_Temp.Data(1, 1) = color
            m_Temp.Data(1, 2) = color: m_Temp.Data(2, 2) = color
            m_Temp.fk_Kind = 2
        Case 3
            m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
            m_Temp.Data(0, 1) = color: m_Temp.Data(1, 1) = color
            m_Temp.Data(2, 1) = color: m_Temp.Data(0, 2) = color
            m_Temp.fk_Kind = 3
        Case 4
            m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
            m_Temp.Data(1, 0) = color: m_Temp.Data(1, 1) = color
            m_Temp.Data(1, 2) = color: m_Temp.Data(0, 0) = color
            m_Temp.fk_Kind = 4
        End Select
    Case 7 '凸型
        m_Temp.ChangeType = 4
        Select Case m_Temp.fk_Kind
        Case 1
            m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
            m_Temp.Data(2, 1) = color: m_Temp.Data(1, 0) = color
            m_Temp.Data(1, 1) = color: m_Temp.Data(1, 2) = color
            m_Temp.fk_Kind = 1
        Case 2
            m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
            m_Temp.Data(0, 1) = color: m_Temp.Data(1, 1) = color
            m_Temp.Data(2, 1) = color: m_Temp.Data(1, 2) = color
            m_Temp.fk_Kind = 2
        Case 3
            m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
            m_Temp.Data(0, 1) = color: m_Temp.Data(1, 0) = color
            m_Temp.Data(1, 1) = color: m_Temp.Data(1, 2) = color
            m_Temp.fk_Kind = 3
        Case 4
            m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -1 * BoxWidth
            m_Temp.Data(0, 1) = color: m_Temp.Data(1, 1) = color
            m_Temp.Data(2, 1) = color: m_Temp.Data(1, 0) = color
            m_Temp.fk_Kind = 4
        End Select
    End Select
   
    If X <> -1 And Y <> -1 Then m_Temp.StartX = X: m_Temp.StartY = Y
    Create_fk = True
Errlab:
   
End Function

Public Function NextToNow()
    Dim i As Integer, j As Integer
    With Now_fk
        .color = Next_fk.color
        .StartX = Next_fk.StartX
        .StartY = Next_fk.StartY
        For i = 0 To 3
            For j = 0 To 3
                .Data(i, j) = Next_fk.Data(i, j)
            Next
        Next
        .ChangeType = Next_fk.ChangeType
        .fk_Kind = Next_fk.fk_Kind
        .Kinds = Next_fk.Kinds
    End With
End Function


Public Function InitNextBox()
    Dim X As Single
    Dim i As Integer, j As Integer
   
    '初始化网格2
    frmMain.bgridnext.ScaleMode = 3   ' 设置 ScaleMode 为像素。
    frmMain.bgridnext.AutoRedraw = True
    BoxWidth = frmMain.bgridnext.ScaleWidth / 4
    frmMain.bgridnext.Line (0, 0)-(frmMain.bgridnext.ScaleWidth, frmMain.bgridnext.ScaleHeight), &H80000005, BF
    For X = 0 To CCol
        frmMain.bgridnext.Line (X * BoxWidth, 0)-(X * BoxWidth, frmMain.bgridnext.ScaleHeight), &HFFC0C0, B
    Next
    For X = 0 To CLine
        frmMain.bgridnext.Line (0, X * BoxWidth)-(frmMain.bgridnext.ScaleWidth, X * BoxWidth), &HFFC0C0, B
    Next
End Function

Public Function InSertNext()
    Dim i As Integer, j As Integer
    Call InitNextBox
    For i = 0 To 3
        For j = 0 To 3
            If Next_fk.Data(i, j) <> 0 Then Call FillEveryOneNext(i * BoxWidth, j * BoxWidth, Next_fk.color)
        Next
    Next
End Function

Private Function CanMove(ByVal var As Integer) As Boolean
    Dim i As Byte, j As Byte
    Dim NewX As Single, NewY As Single
    Dim counter As Integer
    Dim col As Integer, row As Integer
   
    counter = 0
    Select Case var
    Case 1
        i = 3
        Do While i > 0
            For j = 0 To 3
                If Now_fk.Data(j, i) <> 0 Then GoTo lab1
            Next
            i = i - 1
            If j = 4 Then counter = counter + 1
        Loop
        
lab1:
        NewX = Now_fk.StartX
        NewY = Now_fk.StartY + BoxWidth
        
        If NewY / BoxWidth + (4 - counter) <= CLine Then
            For i = 0 To 3
                For j = 0 To 3
                    col = i + NewX / BoxWidth
                    row = j + NewY / BoxWidth
                    If col >= 0 And row >= 0 And Now_fk.Data(i, j) <> 0 And col < CCol And row < CLine Then
                        If grid(row, col) <> 0 Then
                            If Now_fk.StartY < 0 Then
                                If MsgBox("游戏结束!", vbInformation + vbOKOnly, "游戏结束") = vbOK Then Call GameIsOver: Exit Function
                            End If
                            CanMove = False: Exit Function
                        End If
                    End If
                Next
            Next
            CanMove = True
        End If
    Case 2
        For i = 0 To 3
            For j = 0 To 3
                If Now_fk.Data(i, j) <> 0 Then GoTo lab2
            Next
            If j = 4 Then counter = counter + 1
        Next
        
lab2:
        NewX = Now_fk.StartX - BoxWidth
        NewY = Now_fk.StartY
        
        If NewX / BoxWidth + counter >= 0 Then
            For i = 0 To 3
                For j = 0 To 3
                    col = i + NewX / BoxWidth
                    row = j + NewY / BoxWidth
                    If col >= 0 And row >= 0 And Now_fk.Data(i, j) <> 0 And col < CCol And row < CLine Then
                        If grid(row, col) <> 0 Then CanMove = False: Exit Function
                    End If
                Next
            Next
            CanMove = True
        End If
    Case 3
        i = 3
        Do While i > 0
            For j = 0 To 3
                If Now_fk.Data(i, j) <> 0 Then GoTo lab3
            Next
            i = i - 1
            If j = 4 Then counter = counter + 1
        Loop
        
lab3:
   
        NewX = Now_fk.StartX + BoxWidth
        NewY = Now_fk.StartY

        If NewX / BoxWidth + (4 - counter) <= CCol Then
            For i = 0 To 3
                For j = 0 To 3
                    col = i + NewX / BoxWidth
                    row = j + NewY / BoxWidth
                    If col >= 0 And row >= 0 And Now_fk.Data(i, j) <> 0 And col < CCol And row < CLine Then
                        If grid(row, col) <> 0 Then CanMove = False: Exit Function
                    End If
                Next
            Next
            CanMove = True
        End If
    End Select
End Function

Public Function fk_Left()
    If True = CanMove(2) Then
        fk_Clear
        Now_fk.StartX = Now_fk.StartX - BoxWidth
        InSertGrid
    End If
End Function

Public Function fk_Right() As Boolean
    If True = CanMove(3) Then
        fk_Clear
        Now_fk.StartX = Now_fk.StartX + BoxWidth
        InSertGrid
    End If
End Function

Public Function fk_Down() As Boolean
    If True = CanMove(1) Then
        fk_Clear
        Now_fk.StartY = Now_fk.StartY + BoxWidth
        InSertGrid
    Else
        Call EndOfDown
    End If
End Function

Public Function fk_Change()
    Dim i As Integer, j As Integer
    Dim Temp_fk As m_fk
    Dim col As Integer, row As Integer
    Dim Lcounter As Integer, Rcounter As Integer
    Dim Dcounter As Integer
   
    Call Create_fk(Temp_fk, Now_fk.Kinds, Now_fk.StartX, Now_fk.StartY)
   
       For i = 0 To 3
           For j = 0 To 3
               If Temp_fk.Data(i, j) <> 0 Then GoTo lab1
           Next
           If j = 4 Then Lcounter = Lcounter + 1
       Next
lab1:
       i = 3
       Do While i > 0
           For j = 0 To 3
               If Temp_fk.Data(i, j) <> 0 Then GoTo lab2
           Next
           i = i - 1
           If j = 4 Then Rcounter = Rcounter + 1
       Loop
lab2:
        i = 3
        Do While i > 0
            For j = 0 To 3
                If Temp_fk.Data(j, i) <> 0 Then GoTo lab3
            Next
            i = i - 1
            If j = 4 Then Dcounter = Dcounter + 1
        Loop
        
lab3:
    If Temp_fk.StartX / BoxWidth + Lcounter >= 0 Then
        If Temp_fk.StartX / BoxWidth + (4 - Rcounter) <= CCol Then
            If Temp_fk.StartY / BoxWidth + (4 - Dcounter) <= CLine Then
               
                For i = 0 To 3
                    For j = 0 To 3
                        col = i + Temp_fk.StartX / BoxWidth
                        row = j + Temp_fk.StartY / BoxWidth
                        If col >= 0 And row >= 0 And col < CCol And row < CLine And Temp_fk.Data(i, j) <> 0 Then
                            If grid(row, col) <> 0 Then Exit Function
                        End If
                    Next
                Next
               
                fk_Clear
                With Now_fk
                    .color = Temp_fk.color
                    .StartX = Temp_fk.StartX
                    .StartY = Temp_fk.StartY
                    For i = 0 To 3
                        For j = 0 To 3
                            .Data(i, j) = Temp_fk.Data(i, j)
                        Next
                    Next
                    .ChangeType = Temp_fk.ChangeType
                    .fk_Kind = Temp_fk.fk_Kind
                    .Kinds = Temp_fk.Kinds
                End With
                InSertGrid
               
            End If
        End If
    End If
End Function


Private Function fk_Clear()
    Dim i As Integer, j As Integer
    For i = 0 To 3
        For j = 0 To 3
            If Now_fk.Data(i, j) <> 0 Then Call ClearFill(Now_fk.StartX + i * BoxWidth, Now_fk.StartY + j * BoxWidth, vbWhite)
        Next
    Next
End Function

Private Function ClearFill(ByVal X As Single, ByVal Y As Single, ByVal color As Long)
    frmMain.blackGrid.Line (X + 2, Y + 2)-(X + BoxWidth - 2, Y + BoxWidth - 2), color, BF
End Function

Public Function InSertGrid()
    Dim i As Integer, j As Integer
    For i = 0 To 3
        For j = 0 To 3
            If Now_fk.Data(i, j) <> 0 And Now_fk.StartY + j * BoxWidth >= 0 Then Call FillEveryOne(Now_fk.StartX + i * BoxWidth, Now_fk.StartY + j * BoxWidth, Now_fk.color)
        Next
    Next
End Function

Private Function FillEveryOneNext(ByVal X As Single, ByVal Y As Single, ByVal color As Long)
    frmMain.bgridnext.Line (X + 2, Y + 2)-(X + BoxWidth - 2, Y + BoxWidth - 2), color, BF
End Function

Private Function FillEveryOne(ByVal X As Single, ByVal Y As Single, ByVal color As Long)
    frmMain.blackGrid.Line (X + 2, Y + 2)-(X + BoxWidth - 2, Y + BoxWidth - 2), color, BF
End Function


Private Function EndOfDown()
    Dim i As Byte, j As Byte
    Dim col As Integer, row As Integer


    For i = 0 To 3
        For j = 0 To 3
            If Now_fk.Data(i, j) <> 0 Then
                col = i + Now_fk.StartX / BoxWidth
                row = j + Now_fk.StartY / BoxWidth
                If col >= 0 And row >= 0 Then
                   grid(row, col) = Now_fk.Data(i, j)
                End If
            End If
        Next
    Next

    For i = 0 To 3
        For j = 0 To 3
             Now_fk.Data(i, j) = 0
        Next
    Next

    '尝试消去方块
    Call Delete_fk

    frmMain.TopToBottom.Enabled = False
    If False = gameover Then frmMain.GameTimer.Enabled = True
End Function

Private Function Delete_fk()
    Dim i As Integer, j As Integer, K As Integer
    Dim counter As Integer
    Dim color As Long
   
    counter = 0
    Do While True
        For i = CLine - 1 To 0 Step -1
            For j = 0 To CCol - 1
                If grid(i, j) = 0 Then Exit For
            Next
            
            If j = CCol Then '消去
                counter = counter + 1
               
                For K = 0 To CCol - 1
                     grid(i, K) = 0
                     Call FillEveryOne(K * BoxWidth, i * BoxWidth, vbWhite)
                Next
               
                For K = i - 1 To 0 Step -1
                    For j = 0 To CCol - 1
                        grid(K + 1, j) = grid(K, j)
                    Next
                Next
               
                '顶部置空一行
                For j = 0 To CCol - 1
                    grid(0, j) = 0
                Next
           
                For K = 0 To CLine - 1
                    For j = 0 To CCol - 1
                        If grid(K, j) = 0 Then color = vbWhite Else color = grid(K, j)
                        Call FillEveryOne(j * BoxWidth, K * BoxWidth, color)
                    Next
                Next
               
                Exit For
            End If
        Next
        If i = -1 Then Exit Do
    Loop
   
    If counter > 0 Then
        total = total + counter ^ 2 * 100
        If counter > 1 Then total = total - 100
        frmMain.Text1.Item(0).Text = total
        If total > max Then max = total
        
        
        If total / 5000000 > speed And speed < 9 Then
            speed = speed + 1: frmMain.Text1.Item(2) = speed '速度显示控制
            
            '实际速度控制
             frmMain.TopToBottom.Interval = frmMain.TopToBottom.Interval - 70
        End If
    End If
End Function

Private Function GameIsOver()
    Dim i As Integer, j As Integer
   
    For i = 0 To CLine - 1
        For j = 0 To CCol - 1
            grid(i, j) = 0
            Call FillEveryOne(j * BoxWidth, i * BoxWidth, vbBlue)
        Next
    Next
    Call save
   
    frmMain.TopToBottom.Enabled = False
    frmMain.GameTimer.Enabled = False
    gameover = True
    starting = False
End Function

Function save()
On Error Resume Next
    Dim strTemp As String
    strTemp = App.Path & "\data.bin"
    Open strTemp For Binary As #1
    Put #1, 8, max
    Close #1
End Function
2008-05-30 13:39
youshuling520
Rank: 1
等 级:新手上路
帖 子:24
专家分:0
注 册:2008-5-25
收藏
得分:0 
??我不要6.0写的  晕呼呼~~~我要.NET2003 VB语言写的
2008-05-30 20:42
xlin1033xl
Rank: 3Rank: 3
等 级:论坛游侠
帖 子:160
专家分:129
注 册:2007-6-24
收藏
得分:0 
那位老兄把我以前乱写的东西贴出来了?

-------------程序*酒*人生
2008-05-31 14:06
xlin1033xl
Rank: 3Rank: 3
等 级:论坛游侠
帖 子:160
专家分:129
注 册:2007-6-24
收藏
得分:0 
呵呵呵,我上次格盘差点丢失源码了

-------------程序*酒*人生
2008-05-31 14:07
xlin1033xl
Rank: 3Rank: 3
等 级:论坛游侠
帖 子:160
专家分:129
注 册:2007-6-24
收藏
得分:0 
那位兄弟把我以前乱写的东西贴出来了

-------------程序*酒*人生
2008-05-31 14:10
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
查到20600篇
这里那些是您的?

俄罗斯方块.jpg (110.32 KB)
图片附件: 游客没有浏览图片的权限,请 登录注册
2008-05-31 17:14
youshuling520
Rank: 1
等 级:新手上路
帖 子:24
专家分:0
注 册:2008-5-25
收藏
得分:0 
  ,有没有代码呀??最好是做完了得,是用做的哦
2008-05-31 17:34
xlin1033xl
Rank: 3Rank: 3
等 级:论坛游侠
帖 子:160
专家分:129
注 册:2007-6-24
收藏
得分:0 
很高兴与大家分享源码
xlin1033@
这是我的邮箱,你看我的xlin1033xl我的论坛号也用了这个
本人最近很想写游戏外挂,
望写过的兄弟分享一下成果

-------------程序*酒*人生
2008-06-01 12:47
快速回复:俄罗斯方块
数据加载中...
 
   



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

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