焰火效果动图
突然想写一个这个东东,写完后发现还算简单,然后就再加上注释,算给新手看的吧。涉及到的知识点:
1、常量与变量,全局变量与局部变量
2、数组
3、结构体
4、绘图,缓冲绘图不闪烁
5、控件:按钮,定时器,图像框
程序代码:
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