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

dragoon0114

我不知道怎么上传附件，只好把程序粘贴了过来。界面的话根据程序自设吧，要改函数在最后。
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

wanyeqing2003

请问：这个代码有人用过吗？
效果如何？