标题:朋友们帮忙研究一下!音频直方图的动态效果!很有意思的哦!!!
只看楼主
zhc
Rank: 2
等 级:论坛游民
帖 子:12
专家分:10
注 册:2010-12-1
结帖率:100%
已结贴  问题点数:20 回复次数:6 
朋友们帮忙研究一下!音频直方图的动态效果!很有意思的哦!!!
朋友们,谁知道,比如类似播放器里的音频直方图,柱子高度随频率的改变其高度也随之增减
                频率的数据我们有,数据变化半秒一次。用vb怎样实现类似播放器里的音频
                那样动感的效果,那个直方图怎样绘(类似一个个小方块的叠加哦!),还有其高度怎样随数据变化实现其动感
                的效果哦!我觉得这个程序很有意思的!
        大家有什么观点,想法,望一起讨论哦!
                                                       在下谢谢大家的支持!!!
搜索更多相关主题的帖子: 播放器 直方图 
2011-03-11 11:20
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4912
专家分:29900
注 册:2008-10-15
得分:20 
程序代码:
Option Explicit

Public Sub 显示频谱(obj1 As PictureBox, obj2 As PictureBox, data() As Long)
'obj1 目标对象
'obj2 频谱对象
'data() 当次频谱数据

Const MAX = 100             '谱柱数据最大值

Dim i As Long
Dim kd As Long              '谱柱宽度
Dim o As Long               '谱柱数量


Dim x As Long, y As Long    '谱柱左上角坐标
Dim H As Long               '谱柱最大高度

o = UBound(data)                            '谱柱总数
H = obj1.ScaleHeight
kd = obj1.ScaleWidth / (o + 1)                  '每根谱柱的宽度

obj1.Cls

For i = 0 To o                                  '读每个数据
    If data(i) > MAX Then                       '去掉最大值,保证不出错
        data(i) = MAX
    End If
    If data(i) > 0 Then                         '去掉最小值,保证不出错
        x = i * kd
        y = H - data(i) / MAX * H
        obj1.PaintPicture obj2.Image, x, y, kd - 30, H - y, 0, y
    End If
Next i
   
End Sub

Private Sub Command1_Click()
'测试按钮
Dim i As Long
Dim d(10) As Long
For i = 0 To 10                     '产生10个随机数据
    d(i) = Int(Rnd() * 100)
Next i

Call 显示频谱(Picture1, Picture2, d())      '显示


End Sub

Private Sub Form_Load()

Const H = 45        '总高度
Const K = 30        '空位 ,因为显示时,会谥出1像素

'注意:picture1 和 picture2 的高度需要为一样的。
'制作样本
Dim i As Long
Dim j As Long
Dim k1 As Long
k1 = Picture2.ScaleWidth
For i = 0 To Picture2.ScaleHeight / H
    j = (i - 1) * H
    Picture2.Line (0, j)-(k1, j + H - K), , BF
Next i

End Sub

Private Sub Timer1_Timer()
Call Command1_Click
End Sub

窗口的控件:
Picture1     '显示频谱的控件,该控件比较大
Picture2     '此控件与 Picture1 的高度一样,宽度不要很宽
Command1     '测试按钮
Timer1       '半秒执行一次

属性设置:Picture2 的 AutoRedraw = True
          Timer1 的 Interval = 500

--------------------------------------------
不愿上传工程了,因为不想存盘。

授人于鱼,不如授人于渔
早已停用QQ了
2011-03-11 15:37
zhc
Rank: 2
等 级:论坛游民
帖 子:12
专家分:10
注 册:2010-12-1
得分:0 
不好意思啊!让您久等能了!
    我研究研究,去测试哦!
      - 谢谢您的细致耐心!
2011-03-16 10:02
yqb6229281
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2011-3-28
得分:0 
这个确实有趣,但是太高深了,我还是菜鸟呢。2L真热心!赞一个
2011-03-30 11:36
GLove天琊
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2014-2-26
得分:0 
炸天。。
2014-02-26 14:03
wang24113
Rank: 1
等 级:新手上路
帖 子:5
专家分:0
注 册:2014-3-26
得分:0 
2014-04-01 09:52
wang24113
Rank: 1
等 级:新手上路
帖 子:5
专家分:0
注 册:2014-3-26
得分:0 
2014-04-01 09:52



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-333812-1-1.html




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

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