m_fk.bas

VB制作的一款小游戏软件

Attribute VB_Name = "main"
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