'Benötigt wird: eine PictureBox, bei der die Index-Eigenschaft auf 0 gesetzt 
' ist.
Option Explicit
 
Private Declare Function BitBlt& Lib "gdi32" (ByVal hdcDest&, _
  ByVal XDest&, ByVal YDest&, ByVal nWidth&, ByVal nHeight&, _
  ByVal hDCSrc&, ByVal xSrc&, ByVal ySrc&, ByVal dwRop&)
 
Private Sub Form_Activate()
  Dim i%, SW%, SH%, W%, Sc%, ZB%, ZH%, Sour As Object, Dest As Object
 
  Randomize
  Me.ScaleMode = 3
  SW = Me.ScaleWidth
  SH = Me.ScaleHeight
  Me.Caption = "Matrix"
  Load Picture1(1)
  For i = 0 To 1
    With Picture1(i)
    .Visible = False
    .ScaleMode = 3
    .BorderStyle = 0
    .BackColor = 0
    ZB = .TextWidth("W")
    ZH = .TextHeight("W")
    .Move 0, 0, SW, SH + ZH
    .AutoRedraw = True
    .Cls
    End With
  Next i
  Sc = SW \ ZB
  ReDim Speed%(Sc), Z1%(Sc), Z2%(Sc), Fa&(Sc)
  Do
    W = 1 - W
    Set Sour = Picture1(W)
    Set Dest = Picture1(1 - W)
    With Dest
    Call BitBlt(.hDC, 0, 0, SW, SH + ZH, Sour.hDC, 0, 0, vbSrcCopy)
    For i = 0 To Sc - 1
      Z1(i) = Z1(i) + 1
      If Z1(i) > Speed(i) Then
        Z1(i) = 0
        Call BitBlt(.hDC, i * ZB, 1, ZB, SH + ZH - 1, Sour.hDC, i * ZB, 0, _
          vbSrcCopy)
        Z2(i) = Z2(i) + 1
        If Z2(i) = ZH Then
          Z2(i) = 0
          'Dest.Line (i * ZB, 0)-Step(ZB - 1, ZH - 1), 0, BF 'Löschen
          .CurrentX = i * ZB
          .CurrentY = 0
          .ForeColor = Fa(i)
          Dest.Print Chr(33 + 90 * Rnd)
          If Rnd < 0.2 Then
            Speed(Rnd * Sc) = Int(Rnd * 10)
          End If
          If Rnd < 0.05 Then
            Fa(Rnd * Sc) = IIf(Rnd < 0.5, vbCyan, RGB(0, 32 + Rnd * 223, 32 + _
              Rnd * 223))
          End If
        End If
      End If
    Next i
    Call BitBlt(Me.hDC, 0, 0, SW, SH, .hDC, 0, ZH, vbSrcCopy)
    End With
    DoEvents
  Loop
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
  End
End Sub