| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 4047 人关注过本帖, 2 人收藏
标题:焰火效果动图
只看楼主 加入收藏
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
结帖率:100%
收藏(2)
 问题点数:0 回复次数:3 
焰火效果动图
突然想写一个这个东东,写完后发现还算简单,然后就再加上注释,算给新手看的吧。
涉及到的知识点:
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
搜索更多相关主题的帖子: Long 速度 周期 End Dim 
2018-08-12 22:39
wmf2014
Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19
等 级:贵宾
威 望:216
帖 子:2039
专家分:11273
注 册:2014-12-6
收藏
得分:0 
斑竹出马,必为大作!

能编个毛线衣吗?
2018-08-13 14:40
Ghost_01
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2018-8-28
收藏
得分:0 
2018-08-28 21:43
自由柚子
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2018-6-15
收藏
得分:0 
2018-11-04 17:05
快速回复:焰火效果动图
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.035395 second(s), 10 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved