vbtris32.bas

一个很好的VB程序

'Piece 4
'    Y
'  O O
'X X O O X
'    Y
'    Y

'Piece 5
'    Y
'    O O
'X O O X X
'    Y
'    Y

'Piece 6
'    Y
'    O
'X O O O X
'    Y
'    Y

'Piece 7
'    Y
'    O O
'X X O O X
'    Y
'    Y
Dim I

Select Case Board.CurPiece
    'Draw Piece 1
    Case 1
        For I = 4 To 7
            If Board.Square(I, 1) <> 0 Then GameOver = True
            Board.Square(I, 1) = 1
        Next
    'Draw Piece 2
    Case 2
        If Board.Square(4, 1) <> 0 Then GameOver = True
        Board.Square(4, 1) = 2
        For I = 4 To 6
            If Board.Square(I, 2) <> 0 Then GameOver = True
            Board.Square(I, 2) = 2
        Next
    'Draw Piece 3
    Case 3
        If Board.Square(6, 1) <> 0 Then GameOver = True
        Board.Square(6, 1) = 3
        For I = 4 To 6
            If Board.Square(I, 2) <> 0 Then GameOver = True
            Board.Square(I, 2) = 3
        Next
    'Draw Piece 4
    Case 4
        If Board.Square(4, 1) <> 0 Then GameOver = True
        If Board.Square(5, 1) <> 0 Then GameOver = True
        If Board.Square(5, 2) <> 0 Then GameOver = True
        If Board.Square(6, 2) <> 0 Then GameOver = True
        Board.Square(4, 1) = 4
        Board.Square(5, 1) = 4
        Board.Square(5, 2) = 4
        Board.Square(6, 2) = 4
    'Draw Piece 5
    Case 5
        If Board.Square(5, 1) <> 0 Then GameOver = True
        If Board.Square(6, 1) <> 0 Then GameOver = True
        If Board.Square(4, 2) <> 0 Then GameOver = True
        If Board.Square(5, 2) <> 0 Then GameOver = True
        Board.Square(5, 1) = 5
        Board.Square(6, 1) = 5
        Board.Square(4, 2) = 5
        Board.Square(5, 2) = 5
    'Draw Piece 6
    Case 6
        If Board.Square(5, 1) <> 0 Then GameOver = True
        Board.Square(5, 1) = 6
        For I = 4 To 6
            If Board.Square(I, 2) <> 0 Then GameOver = True
            Board.Square(I, 2) = 6
        Next
    'Draw Piece 7
    Case 7
        If Board.Square(5, 1) <> 0 Then GameOver = True
        If Board.Square(6, 1) <> 0 Then GameOver = True
        If Board.Square(5, 2) <> 0 Then GameOver = True
        If Board.Square(6, 2) <> 0 Then GameOver = True
        Board.Square(5, 1) = 7
        Board.Square(6, 1) = 7
        Board.Square(5, 2) = 7
        Board.Square(6, 2) = 7
End Select

End Sub

Sub GenerateINIFile()
'-------------------------------------------------------
'Initializes the variables that are recorded in the INI
'file and then calls the WriteINIFile procedure
'-------------------------------------------------------
StartingLevel = 0
FillLines = False
PlaySounds = False
HideSplash = False
WriteINIFile

End Sub

Sub GetScores()
'-------------------------------------------------------
'Read in the list of scores from the file called
'"scores.list" which is located in the same directory
'as the program.  If it is not there, the program will
'create a new one
'-------------------------------------------------------
Dim CurLine, N, S, I, Spot
'Open the file and create one if it doesn't exist
On Error GoTo NeedNewFile
Open App.Path & "\scores.lst" For Input As #1
On Error GoTo 0
For I = 1 To 5
    'Read in Line I
    Line Input #1, CurLine
    'Find the ":" which denotates the end of the name
    'and the beginning of the score
    Spot = InStr(CurLine, ":")
    'Put the name into N
    N = Mid(CurLine, 1, Spot - 1)
    'Put the score into S
    S = Val(Mid(CurLine, Spot + 1, Len(CurLine)))
    'Put the name and the score into the appropriate array
    ScoreN(I) = N
    Scores(I) = S
Next
'Close the file
Close #1
Exit Sub
NeedNewFile:
Dim Msg As String
'Create the file
Open App.Path & "\scores.lst" For Binary As #1
For I = 1 To 5
    'Create generic scores
    Msg = Msg & "None:0" & Chr$(13) & Chr$(10)
Next
'Store the new list in the file
Put 1, , Msg
'Close the file and reopen it for input to be used above
Close #1
Open App.Path & "\scores.lst" For Input As #1
Resume Next
End Sub

Sub MovePieceDown()
'-------------------------------------------------------
'Moves the piece down one space provided nothing stops
'it from doing so.  If something does, it tells the game
'that it needs a new piece
'-------------------------------------------------------

'Piece 1
'  Pos 1       Pos 2
'    X           X
'    X           O
'Y O O O O   Y Y O Y Y
'    X           O
'    X           O
'
'Piece 2
'  Pos 1       Pos 2       Pos 3       Pos 4
'    X           X           X           X
'  O X           O O         X           O
'Y O O O Y   Y Y O Y Y   Y O O O Y   Y Y O Y Y
'    X           O           X O       O O
'    X           X           X           X
'
'Piece 3
'  Pos 1       Pos 2       Pos 3       Pos 4
'    X           X           X           X
'    X O         O           X         O O
'Y O O O Y   Y Y O Y Y   Y O O O Y   Y Y O Y Y
'    X           O O       O X           O
'    X           X           X           X
'
'Piece 4
'  Pos 1       Pos 2
'    X           X
'  O O           X O
'Y Y O O Y   Y Y O O Y
'    X           O
'    X           X
'
'Piece 5
'  Pos 1       Pos 2
'    X           X
'    O O         O
'Y O O Y Y   Y Y O O Y
'    X           X O
'    X           X
'
'Piece 6
'  Pos 1       Pos 2       Pos 3       Pos 4
'    X           X           X           X
'    O           O           X           O
'Y O O O Y   Y Y O O Y   Y O O O Y   Y O O Y Y
'    X           O           O           O
'    X           X           X           X
'
'Piece 7
'  Pos 1
'    X
'    O O
'Y Y O O Y
'    X
'    X

Dim I
'Determines what piece is currently moving and what
'position it is in.  This tells it where to look for things
'that are in its way.  Provided nothing is there and it has
'not reached the bottom, it moves down.  Plays the appropriate
'sound as well.

Select Case Board.CurPiece
    Case 1
        If Board.PiecePos = 1 Then
            If Board.PieceY <= 17 Then
                If Board.Square(Board.PieceX - 1, Board.PieceY + 1) = 0 And Board.Square(Board.PieceX, Board.PieceY + 1) = 0 And Board.Square(Board.PieceX + 1, Board.PieceY + 1) = 0 And Board.Square(Board.PieceX + 2, Board.PieceY + 1) = 0 Then
                    For I = Board.PieceX - 1 To Board.PieceX + 2
                        Board.Square(I, Board.PieceY) = 0
                        Board.Square(I, Board.PieceY + 1) = 1
                    Next
                    Board.PieceY = Board.PieceY + 1
                Else
                    NewPiece = True
                End If
            Else
                NewPiece = True
            End If
        ElseIf Board.PiecePos = 2 Then
            If Board.PieceY <= 15 Then
                If Board.Square(Board.PieceX, Board.PieceY + 3) = 0 Then
                    Board.Square(Board.PieceX, Board.PieceY - 1) = 0
                    Board.Square(Board.PieceX, Board.PieceY + 3) = 1
                    Board.PieceY = Board.PieceY + 1
                Else
                    NewPiece = True
                End If
            Else
                NewPiece = True
            End If
        End If
    Case 2
        If Board.PiecePos = 1 Then
            If Board.PieceY <= 17 Then
                If Board.Square(Board.PieceX - 1, Board.PieceY + 1) = 0 And Board.Square(Board.PieceX, Board.PieceY + 1) = 0 And Board.Square(Board.PieceX + 1, Board.PieceY + 1) = 0 Then
                    Board.Square(Board.PieceX - 1, Board.PieceY - 1) = 0
                    For I = Board.PieceX - 1 To Board.PieceX + 1
                        If I <> Board.PieceX - 1 Then Board.Square(I, Board.PieceY) = 0
                        Board.Square(I, Board.PieceY + 1) = 2
                    Next
                    Board.PieceY = Board.PieceY + 1
                Else
                    NewPiece = True
                End If
            Else
                NewPiece = True
            End If
        ElseIf Board.PiecePos = 2 Then
            If Board.PieceY <= 16 Then
                If Board.Square(Board.PieceX, Board.PieceY + 2) = 0 And Board.Square(Board.PieceX + 1, Board.PieceY) = 0 Then
                    Board.Square(Board.PieceX, Board.PieceY - 1) = 0
                    Board.Square(Board.PieceX + 1, Board.PieceY - 1) = 0
                    Board.Square(Board.PieceX, Board.PieceY + 2) = 2
                    Board.Square(Board.PieceX + 1, Board.PieceY) = 2
                    Board.PieceY = Board.PieceY + 1
                Else
                    NewPiece = True
                End If
            Else
                NewPiece = True
            End If
        ElseIf Board.PiecePos = 3 Then
            If Board.PieceY <= 16 Then
                If Board.Square(Board.PieceX - 1, Board.PieceY + 1) = 0 And Board.Square(Board.PieceX, Board.PieceY + 1) = 0 And Board.Square(Board.PieceX + 1, Board.PieceY + 2) = 0 Then
                    For I = Board.PieceX - 1 To Board.PieceX + 1
                        Board.Square(I, Board.PieceY) = 0
                        If I <> Board.PieceX + 1 Then Board.Square(I, Board.PieceY + 1) = 2
                    Next
                    Board.Square(Board.PieceX + 1, Board.PieceY + 2) = 2
                    Board.PieceY = Board.PieceY + 1
                Else
                    NewPiece = True
                End If
            Else
                NewPiece = True
            End If
        ElseIf Board.PiecePos = 4 Then
            If Board.PieceY <= 16 Then
                If Board.Square(Board.PieceX - 1, Board.PieceY + 2) = 0 And Board.Square(Board.PieceX, Board.PieceY + 2) = 0 Then
                    Board.Square(Board.PieceX, Board.PieceY - 1) = 0
                    Board.Square(Board.PieceX - 1, Board.PieceY + 1) = 0
                    Board.Square(Board.PieceX, Board.PieceY + 2) = 2
                    Board.Square(Board.PieceX - 1, Board.PieceY + 2) = 2
                    Board.PieceY = Board.PieceY + 1
                Else
                    NewPiece = True
                End If
            Else
                NewPiece = True
            End If
        End If
    Case 3
        If Board.PiecePos = 1 Then
            If Board.PieceY <= 17 Then
                If Board.Square(Board.PieceX - 1, Board.PieceY + 1) = 0 And Board.Square(Board.PieceX, Board.PieceY + 1) = 0 And Board.Square(Board.PieceX + 1, Board.PieceY + 1) = 0 Then
                    Board.Square(Board.PieceX + 1, Board.PieceY - 1) = 0
                    For I = Board.PieceX - 1 To Board.PieceX + 1
                        If I <> Board.PieceX + 1 Then Board.Square(I, Board.PieceY) = 0