Private Type Ptype
    X As Long
    Y As Long
    Xv As Long
    Yv As Long
    LifeSpan As Long
End Type

Const Max = 250
Dim Particle(Max) As Ptype
Dim bRunning As Boolean
Dim Xstart As Long, Ystart As Long
Dim i As Long

Private Sub Form_Load()
Show

Xstart = ScaleWidth \ 2
Ystart = ScaleHeight \ 2

For i = 0 To Max
    Particle(i).LifeSpan = Rnd * 500

    Particle(i).X = Xstart
    Particle(i).Y = Ystart

    Particle(i).Yv = Rnd * -15
    Particle(i).Xv = Rnd * -10 + 5
Next i

bRunning = True
ParticleLoop
End Sub

Private Sub ParticleLoop()
Do While bRunning
    DoEvents

    For i = 0 To Max
        PSet (Particle(i).X, Particle(i).Y), BackColor

        Particle(i).X = Particle(i).X + Particle(i).Xv
        Particle(i).Y = Particle(i).Y + Particle(i).Yv

        Particle(i).Yv = Particle(i).Yv + 0.96

        If Particle(i).Y >= ScaleHeight Then
            Particle(i).Yv = -(Particle(i).Yv * 0.46)
            Particle(i).Y = ScaleHeight
        End If

        Particle(i).LifeSpan = Particle(i).LifeSpan - 1

        If Particle(i).LifeSpan <= 0 Then
            Particle(i).LifeSpan = Rnd * 500
            Particle(i).X = Xstart
            Particle(i).Y = Ystart
            Particle(i).Yv = Rnd * -15
            Particle(i).Xv = Rnd * -10 + 5
        End If

        PSet (Particle(i).X, Particle(i).Y), RGB(0, 0, 0)

    Next i
    Refresh
Loop
End Sub

Private Sub Form_Unload(Cancel As Integer)
bRunning = False
End
End Sub

PSet