http://bbs.pfan.cn/post-26526.html

以下为转帖代码。这个贴2004年的时候有人在论坛发过。现在重新转帖出来，让学习QB的人知道下QB的功能。

'*****************************************************
'* File name: Matrix.bas                             *
'* Author:    JingTao                                *
'* Update:    2004/01/19                             *
'*         A matrix text stream demo program         *
'*                                                   *
'*****************************************************

Const MatrixTextStreamLength% = 15  'REM 0<It<MaxColor
Const LowestSpeed! = 0.3            'REM The lowest speed
Const TextStreamCount% = 20         'REM Count of text streams

Type MatrixTextStreamType
    X As Integer
    Y As Single
    Speed As Single
    Text As String * MatrixTextStreamLength
End Type

Const ScreenMode% = 12              'REM G:640*480*16, T:80*30
Const ScreenTextWidth% = 80
Const ScreenTextHeight% = 30
CONST FALSE% = 0
CONST TRUE% = NOT FALSE

DECLARE FUNCTION UpdateTextStream% (TextStream AS MatrixTextStreamType)
DECLARE SUB DisplayTextStream (TextStream AS MatrixTextStreamType)
DECLARE SUB GenerateTextStream (TextStream AS MatrixTextStreamType)
DECLARE SUB ChangeText (TextStream AS MatrixTextStreamType)
DECLARE SUB GenerateMatrixPalette ()

Dim MatrixTextStream(TextStreamCount) As MatrixTextStreamType

Screen ScreenMode
Cls

Dim Count As Integer

For Count = 1 To TextStreamCount
    GenerateTextStream MatrixTextStream(Count)
Next

GenerateMatrixPalette

While INKEY$ <> Chr$(27)
    For Count = 1 To TextStreamCount
        DisplayTextStream MatrixTextStream(Count)
        If UpdateTextStream(MatrixTextStream(Count)) Then
            GenerateTextStream MatrixTextStream(Count)
        End If
    Next
Wend

End

Sub ChangeText(TextStream As MatrixTextStreamType)

    Dim Count As Integer
    Dim TempText As String

    Randomize Timer
    For Count = 1 To MatrixTextStreamLength - 1
        TempText = TempText + Chr$(Rnd * 222 + 33)
    Next

    TextStream.Text = " " + TempText

End Sub

Sub DisplayTextStream(TextStream As MatrixTextStreamType)

    Dim Count As Integer
    Dim CharX As Integer, CharY As Single

    For Count = 1 To MatrixTextStreamLength

        CharX = TextStream.X
        CharY = TextStream.Y + Count

        If CharY < ScreenTextHeight + 1 And CharY > 1 Then
            If CharX <= ScreenTextWidth And CharX > 0 Then
                LOCATE Int(CharY), CharX
                Color (MatrixTextStreamLength - Count + 1)
                Print Mid$(TextStream.Text, Count, 1);
            End If
        End If

    Next

End Sub

Sub GenerateMatrixPalette()
    Dim Count As Integer
    Dim Red As Integer, Green As Integer, Blue As Integer

    For Count = 1 To MatrixTextStreamLength
        Red = 0
        Green = 63 - (Count - 1) * (64 / MatrixTextStreamLength)
        Blue = 63 - (Count - 1) * (64 / MatrixTextStreamLength)
        Palette Count, Red + Green * 256 + Blue * 65536
    Next

End Sub

Sub GenerateTextStream(TextStream As MatrixTextStreamType)
    
    Randomize Timer
    TextStream.X = Int(Rnd * ScreenTextWidth) + 1
    TextStream.Y = -Rnd * MatrixTextStreamLength
    TextStream.Speed = Rnd + LowestSpeed
    ChangeText TextStream

End Sub

Function UpdateTextStream%(TextStream As MatrixTextStreamType)

    TextStream.Y = TextStream.Y + TextStream.Speed
    ChangeText TextStream
    If TextStream.Y > ScreenTextHeight + 1 Then
        UpdateTextStream = True
        Exit Function
    End If
    UpdateTextStream = False

End Function