'Benötigt wird eine Picturebox
Option Explicit
 
Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
 
Private Declare Function FillRect& Lib "user32" (ByVal hdc&, ConstRect As RECT, _
  ByVal HdcBrush&)
Private Declare Function CreateSolidBrush& Lib "gdi32" (ByVal crColor&)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject&)
 
Private Sub Form_Activate()
 
Dim SW&, SH&, P1hdc&, i&, FarbBrush&(4), Block As RECT, T1!, T2!
 
Randomize
Me.ScaleMode = vbPixels
Me.BackColor = RGB(0, 0, 64)
With Picture1
  .ScaleMode = vbPixels
  .AutoRedraw = True
  .BackColor = vbBlack
  SW = .ScaleWidth
  SH = .ScaleHeight
  P1hdc = .hdc
 
  T1 = Timer
  Do: Loop Until Timer > T1
  T1 = Timer
  'benötigte Brushs erstellen
  For i = 0 To 4
    FarbBrush(i) = CreateSolidBrush(Choose(i + 1, vbRed, vbBlue, vbGreen, _
      vbYellow, vbMagenta))
  Next i
  For i = 1 To 1000
    With Block
      .Left = Rnd * (SW - 30) 'X-Position
      .Top = Rnd * (SH - 30) 'Y-Position
      .Right = .Left + 5 + Rnd * 25 'Breite
      .Bottom = .Top + 5 + Rnd * 25 'Höhe
    End With
    'Rechteck zeichnen
    FillRect P1hdc, Block, FarbBrush(Int(Rnd * 5))
  Next i
  'Brushs wieder löschen
  For i = 0 To 4
    Call DeleteObject(FarbBrush(i))
  Next i
  .Refresh
End With
T2 = Timer
MsgBox "Zeit: " & (T2 - T1) & " Sek."
 
End Sub

Gruss,

Zardoz