Ich hasse es, wenn etwas nicht Funktioniert!!!!

'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

If Z1(i) > Speed(i) Then

If Z1(i) >= Speed(i) Then

Ich hasse es, wenn etwas nicht Funktioniert!!!!

MfG Sascha

Video Disk Rekorder marke eigenbau

http://www.vdrportal.de

Wenn Windows XP die Antwort ist, wie dumm war dann die Frage?

dbayerTo be is to do (Rene Descartes)To do is to be (Kant / Nietzsche / Sartre u.a.)Do be do be dooo (Frank Sinatra, Strangers in the Night)

Wenn Windows XP die Antwort ist, wie dumm war dann die Frage?

'Benötig wird: 1 Picturebox, 1 Timer-Control
Option Explicit
 
Private Declare Function TextOut& Lib "gdi32" Alias "TextOutA" _
  (ByVal hdc As Long, ByVal X&, ByVal y&, ByVal lpString$, ByVal nCount&)
 
Private S() As Byte, F&(), Z1%(), Z2%(), PSW%, PSH%
Private KLM%, ZLN%, ZB%, ZH%
 
Private Sub Form_Activate()
 
Dim ProH%, ProV%, Tt$
 
ProH = 70 'Grafikbreite in Prozent
ProV = 60 'Grafikhöhe in Prozent
Tt = "M A T R I X    R E L O A D E D"
Randomize
Me.WindowState = vbMaximized
Me.BackColor = vbBlack
Me.ScaleMode = vbTwips
Me.FontBold = True
Me.Caption = Space((Me.Width - Me.TextWidth(Tt)) \ Me.TextWidth("  ")) & Tt
Me.FontBold = False
Me.ScaleMode = vbPixels
With Picture1
.BorderStyle = 0
.ScaleMode = vbPixels
.AutoRedraw = True
.BackColor = vbBlack
ZB = .TextWidth("W")
ZH = .TextHeight("W")
PSW = ZB * Int(Me.ScaleWidth * ProH / 100 / ZB)
PSH = ZH * Int(Me.ScaleHeight * ProV / 100 / ZH)
.Move (Me.ScaleWidth - PSW) \ 2, (Me.ScaleHeight - PSH) \ 2, PSW, PSH
End With
KLM = PSW \ ZB - 1
ZLN = PSH \ ZH - 1
ReDim Z1(KLM), Z2(KLM), S(ZLN + 1, KLM), F(ZLN + 1, KLM)
Timer1.Interval = 20
Timer1.Enabled = True
 
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
  End
End Sub
 
Private Sub Timer1_Timer()
 
Dim i%, j%
 
With Picture1
For i = 0 To KLM
  Z2(i) = Z2(i) - 1
  If Z2(i) < 0 Then
    Z2(i) = Z1(i)
    Picture1.Line (i * ZB, 0)-Step(ZB - 1, PSH - 1), vbBlack, BF
    S(ZLN + 1, i) = Int(32 + Rnd * 223)
    F(ZLN + 1, i) = IIf(Rnd < 0.9, RGB(0, 32 + Rnd * 223, 0), vbWhite)
    If Rnd > 0.9 Then Z1(Rnd * KLM) = Int(Rnd * 5)
    For j = 0 To ZLN
      S(j, i) = S(j + 1, i)
      F(j, i) = F(j + 1, i)
      .ForeColor = F(j, i)
      Call TextOut(.hdc, i * ZB, (ZLN - j) * ZH, Chr(S(j, i)), 1)
    Next j
  End If
Next i
End With
 
End Sub