dragoon0114 发表于 2008-1-28 15:54

用VB实现FFT信号分析的程序分享

我不知道怎么上传附件,只好把程序粘贴了过来。界面的话根据程序自设吧,要改函数在最后。
Dim FUZHI(255), PINZHIr(255), PINZHIi(255), PINZHI(255) As Double
Dim TU_DATA(2047) As Integer
Dim P_START, I_TIME, P_POINT As Integer
Dim PAI, A1, A2, A3, S1, S2, S3 As Double
Dim fr(7, 255) As Double
Dim fi(7, 255) As Double
Dim Shuxu(255) As Integer
Dim TX As Integer
Private Sub Command1_Click()
'启动,设置初始值
I_TIME = 0
P_START = 0
Picture1(0).Cls
Picture1(1).Cls
Picture1(0).Visible = True
Picture1(0).Line (6400, 1200)-(0, 1200), RGB(255, 0, 0)
Timer1.Enabled = True
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Command3_Click()
'频谱图形显示方式
TX = (TX + 1) Mod 2
End Sub

Private Sub Form_Load()
TX = 0
PAI = 3.14159
Timer1.Enabled = False
'加权系数W
For i = 0 To 7
For j = 0 To 2 ^ i - 1
aa = Cos(2 * PAI * j / 2 ^ (i + 1))
Call ZHENG(aa)
fr(i, j) = aa
fr(i, j + 2 ^ i) = -aa
bb = Sin(2 * PAI * j / 2 ^ (i + 1))
Call ZHENG(bb)
fi(i, j + 2 ^ i) = bb
fi(i, j) = -bb
Next j
Next i

'倒序
For i = 0 To 255
Shuxu(i) = 0
For j = 0 To 7
a = i And (2 ^ (7 - j))
If a > 0 Then a = 1
Shuxu(i) = Shuxu(i) + a * (2 ^ j)
Next j
Next i
Label12.Caption = "截止窗" + Str(Int((HScroll6.Value / 256) * 100) / 100)
End Sub

Private Sub HScroll1_Change()
'合成谐波信号的频率
A1 = HScroll1.Value / 2
Label5.Caption = A1
End Sub

Private Sub HScroll2_Change()
'合成谐波信号的相位
S1 = HScroll2.Value * PAI / 180
Label6.Caption = HScroll2.Value
End Sub

Private Sub HScroll3_Change()
'合成谐波信号的频率
A2 = HScroll3.Value / 2
Label7.Caption = A2
End Sub

Private Sub HScroll4_Change()
'合成谐波信号的相位
S2 = HScroll4.Value * PAI / 180
Label8.Caption = HScroll4.Value
End Sub
Private Sub HScroll6_Change()
Label12.Caption = "截止窗" + Str(Int((HScroll6.Value / 256) * 100) / 100)
End Sub

Private Sub HScroll7_Change()
'合成谐波信号的相位
S3 = HScroll7.Value * PAI / 180
Label18.Caption = HScroll7.Value
End Sub

Private Sub HScroll8_Change()
'合成谐波信号的频率
A3 = HScroll8.Value / 2
Label19.Caption = A3
End Sub

Private Sub Timer1_Timer()
Call shuju
P_POINT = I_TIME Mod 256
FUZHI(P_POINT) = TU_DATA(I_TIME) / 100
If I_TIME > 255 Then Call FFT 'begin FFT
If P_START = 0 Then Picture1(0).PSet (0, 1200 - TU_DATA(I_TIME))
If P_START <= 256 Then Picture1(0).Line -(P_START * 25, 1200 - TU_DATA(I_TIME)), RGB(128, 255, 2550)
If P_START > 256 Then P_START = 256: Call pic_draw
I_TIME = (I_TIME + 1) Mod 2048
P_START = P_START + 1
End Sub
Private Sub FFT()
Dim H(255), G(255) As Double

'将采集数据按倒序结果赋值
For i = 0 To 255
kk = (Shuxu(i) + P_POINT + 1) Mod 256
PINZHIr(i) = FUZHI(kk)
PINZHIi(i) = 0
Next i

'FFT
For k = 0 To 7               '变换次数:8次*256
Ai = 2 ^ k
For i = 0 To 2 ^ (7 - k) - 1 '分组的组个数:128、64、32、16、8、 4、 2、0
Bi = 2 * i * Ai
For j = 0 To 2 ^ (k + 1) - 1 '每组数据个数:2、4、8、16、32、64、128、256
Ci = Bi + j
If j < Ai Then
   H(Ci) = PINZHIr(Ci) + fr(k, j) * PINZHIr(Ci + Ai) - fi(k, j) * PINZHIi(Ci + Ai)
   G(Ci) = PINZHIi(Ci) + fi(k, j) * PINZHIr(Ci + Ai) + fr(k, j) * PINZHIi(Ci + Ai)
Else
   H(Ci) = PINZHIr(Ci - Ai) + fr(k, j) * PINZHIr(Ci) - fi(k, j) * PINZHIi(Ci)
   G(Ci) = PINZHIi(Ci - Ai) + fr(k, j) * PINZHIi(Ci) + fi(k, j) * PINZHIr(Ci)
End If
Next j
Next i
For w = 0 To 255
PINZHIr(w) = H(w)
PINZHIi(w) = G(w)
Next w
Next k

Picture1(1).Cls
Picture1(1).PSet (0, 2300)
For j = 0 To 127
PINZHI(j) = (PINZHIr(j) * PINZHIr(j) + PINZHIi(j) * PINZHIi(j)) ^ 0.5
Call ZHENG(PINZHI(j))
If TX = 0 Then Picture1(1).Line -(100 * j, 2300 - PINZHI(j) * 5), RGB(255, 0, 0)
If TX = 1 Then Picture1(1).Line (100 * j, 2300)-(100 * j, 2300 - PINZHI(j) * 5), RGB(255, 0, 0)
Next j
'横坐标点
For j = 0 To 12
Picture1(1).Circle (j * HScroll6.Value * 1000 / 256, 2300), 20, RGB(255, 0, 0)
Next j
End Sub
Private Sub pic_draw()
Picture1(0).Cls
Picture1(0).Line (0, 1200)-(6400, 1200), RGB(255, 0, 0)
Picture1(0).PSet (6400, 1200 - TU_DATA(I_TIME))
For i = 1 To 256
kk = (I_TIME - i + 2048) Mod 2048
Picture1(0).Line -(6400 - i * 25, 1200 - TU_DATA(kk)), RGB(128, 255, 2550)
Next i
End Sub
Sub shuju()
xx2 = 128 / (Int((HScroll6.Value / 256) * 100) / 100)
xx = 3 * Sin(A1 * PAI * I_TIME / xx2 + S1) + 2 * Cos(A2 * PAI * I_TIME / xx2 + S2) + Sin(A3 * PAI * I_TIME / xx2 + S3)
Call ZHENG(xx)
TU_DATA(I_TIME) = xx * 100
End Sub
Sub ZHENG(xx)
If Abs(xx) < 0.00001 Then xx = 0
xx = Int(xx * 100000 + 0.5) / 100000
End Sub

[ 本帖最后由 风花雪月 于 2008-1-29 15:02 编辑 ]

wanyeqing2003 发表于 2008-2-5 09:28

收藏了。

风花雪月 发表于 2008-2-19 16:08

原帖由 dragoon0114 于 2008-1-28 15:54 发表 http://www.chinavib.com/forum/images/common/back.gif
我不知道怎么上传附件,只好把程序粘贴了过来。

见发帖输入框下面的上传附件

dragoon0114 发表于 2008-2-22 17:42

我晕啊,不能上传.frm(VB)格式的文件。

风花雪月 发表于 2008-3-5 10:51

原帖由 dragoon0114 于 2008-2-22 17:42 发表 http://www.chinavib.com/forum/images/common/back.gif
我晕啊,不能上传.frm(VB)格式的文件。

呵呵,现在文件格式多了去了,论坛只能上传特定几个扩展名的文件

宝贝鱼 发表于 2008-5-8 10:10

你好,我想知道这段代码是做什么用的

'加权系数W
For i = 0 To 7
For j = 0 To 2 ^ i - 1                     
aa = Cos(2 * PAI * j / 2 ^ (i + 1))
Call ZHENG(aa)
fr(i, j) = aa
fr(i, j + 2 ^ i) = -aa
bb = Sin(2 * PAI * j / 2 ^ (i + 1))
Call ZHENG(bb)
fi(i, j + 2 ^ i) = bb
fi(i, j) = -bb
Next j
Next i

Sub ZHENG(xx)
If Abs(xx) < 0.00001 Then xx = 0
xx = Int(xx * 100000 + 0.5) / 100000
End Sub

还有啊,怎么确定采样点数是256呢?

babys 发表于 2008-5-17 20:00

能不能把程序贴出来啊?
有用啊

xjyhuijia 发表于 2011-1-5 20:54

正需要相关程序呢,分享了

letian882236 发表于 2011-3-18 23:19

回复 4 # dragoon0114 的帖子

麻烦楼主给控件截个图呗,知道怎样安排就好做了,万分感谢!

88484532 发表于 2011-7-28 12:17

先收藏了,谢谢提供。

zhangzihang0820 发表于 2014-11-17 22:47

谢谢提供
页: [1]
查看完整版本: 用VB实现FFT信号分析的程序分享