焰火效果动图

Option Explicit

' 窗体，拉一个 Command1；
' 放一个Timer1，设 Interval = 50（可以自己调节)，Enabled = False
' 放一个 Picture1 ，尽量放大一点 ,再放一个 Picture2 ，这个不作要求，代码里会重叠这二个控件
' Picture1 的长宽比尽量做到 1：1 。 绘图控件为 Picture1 ,显示控件为 Picture2

' 放一个 Picture3 ，输出DEBUG用，不需要可以删


Const 数据多少 = 500
Const PI = 3.14159

Private Type 数据结构
    x As Long
    y As Long
    方向 As Single
    速度 As Single
    存活周期 As Long
    颜色 As Long
    大小 As Long        '绘图半径
End Type

Dim D(数据多少) As 数据结构

Dim 重力 As Single
Dim 阻力 As Single

Dim 运行周期 As Long

Private Sub Command1_Click()

Dim i As Long
For i = 1 To 数据多少
    With D(i)
        .x = 0                                          '焰火中心点X
        .y = 800                                        '焰火中心点X
        .存活周期 = 40 * Rnd() + 20                     '存活周期，最小为40周期,建议最大和最小之间偏差不要太大
        .速度 = Rnd() * 5 + 1                           '向外扩散速度
        .方向 = Rnd() * 2 * PI                          '角度单位：弧度 .
        .颜色 = Rnd() * 16581375                        '随机颜色，255*255*255 = 16581375 ,在 LONG 范围之内，未考虑是否看得清
        .大小 = 6 + Rnd() * 4                           '每个颗粒绘图大小
    End With
Next i

运行周期 = 0
Timer1.Enabled = True                                   '开定时器

End Sub

Private Sub Form_Load()

Picture1.Scale (1000, 1000)-(-1000, -1000)              '设置自定义坐标系
重力 = 0.5                                              '按运行周期整体会向下移动，以产生坠落效果
阻力 = 0.05                                             '向外扩散速度降低，以产生 前期快后期慢的效果

Randomize               '初始化随机数发生器

'Picture1 设为自动重绘，重叠 Picture2 到 Picture1上面
    Picture1.AutoRedraw = True
    Picture2.Move Picture1.Left, Picture1.Top, Picture1.Width, Picture1.Height
    Picture2.ZOrder (0)

End Sub

Private Sub 散开()
Dim i As Long
Dim x As Long, y As Long
Dim nojs As Long
运行周期 = 运行周期 + 1
For i = 1 To 数据多少
    With D(i)
        If .存活周期 > 0 Then
            .x = .x + .速度 * Sin(.方向)                                'sin 和 cos 傻傻的分不清哪个X轴，那个Y轴了，这里影响不大，就不管了。
            .y = .y + .速度 * Cos(.方向) - 重力 * 运行周期              '重力加成的速度是越来越大
            .存活周期 = .存活周期 - 1
            If .速度 > 阻力 Then .速度 = .速度 - 阻力                   '速度不能降为负数
        Else
            nojs = nojs + 1                                             '统计还有多少存活，以停止运行
        End If
    End With
Next i

If nojs = i - 1 Then                                '全部不存活
    Timer1.Enabled = False                          '停定时器
End If

'------DEBUG输出------
Picture3.Cls
Picture3.Print "运行周期："; 运行周期
Picture3.Print "已消失粒："; nojs

End Sub

Private Sub 绘图()

Dim i As Long
Dim j As Long
Picture1.Cls
For i = 1 To 数据多少
    With D(i)
        If .存活周期 > 0 Then            
            Picture1.DrawWidth = .大小 / 2                  '线条宽为大小一半
            Picture1.Circle (.x, .y), .大小 / 2, .颜色      '以大小一半画圆，得到实心圆
        End If
    End With
Next i

'复制 Picture1（缓冲区）图像到 Picture2（显示区）中，达到不闪烁效果
Picture2.PaintPicture Picture1.Image, 0, 0

End Sub

Private Sub Timer1_Timer()
    Call 散开
    Call 绘图
End Sub