fft算法的vb实现.txt

来自「FFT算法的VB实现.在VB中简单调用」· 文本 代码 · 共 156 行

'*模块******************************************************** 
'FFT0 数组下标以0开始 FFT1 数组下标以1开始 
'AR() 数据实部 AI() 数据虚部 
'N 数据点数，为2的整数次幂 
'NI 变换方向 1为正变换，-1为反变换 
'*************************************************************** 

Public Const Pi = 3.1415926 

Public Function FFT0(AR() As Double, AI() As Double, N As Integer, ni As Integer) 
Dim i As Integer, j As Integer, k As Integer, L As Integer, M As Integer 
Dim IP As Integer, LE As Integer 
Dim L1 As Integer, N1 As Integer, N2 As Integer 
Dim SN As Double, TR As Double, TI As Double, WR As Double, WI As Double 
Dim UR As Double, UI As Double, US As Double 
M = NTOM(N) 
N2 = N / 2 
N1 = N - 1 
SN = ni 
j = 1 
For i = 1 To N1 
If i < j Then 
TR = AR(j - 1) 
AR(j - 1) = AR(i - 1) 
AR(i - 1) = TR 
TI = AI(j - 1) 
AI(j - 1) = AI(i - 1) 
AI(i - 1) = TI 
End If 
k = N2 
While (k < j) 
j = j - k 
k = k / 2 
Wend 
j = j + k 
Next i 
For L = 1 To M 
LE = 2 ^ L 
L1 = LE / 2 
UR = 1# 
UI = 0# 
WR = Cos(Pi / L1) 
WI = SN * Sin(Pi / L1) 
For j = 1 To L1 
For i = j To N Step LE 
IP = i + L1 
TR = AR(IP - 1) * UR - AI(IP - 1) * UI 
TI = AI(IP - 1) * UR + AR(IP - 1) * UI 
AR(IP - 1) = AR(i - 1) - TR 
AI(IP - 1) = AI(i - 1) - TI 
AR(i - 1) = AR(i - 1) + TR 
AI(i - 1) = AI(i - 1) + TI 
Next i 
US = UR 
UR = US * WR - UI * WI 
UI = UI * WR + US * WI 
Next j 
Next L 
If SN <> -1 Then 
For i = 1 To N 
AR(i - 1) = AR(i - 1) / N 
AI(i - 1) = AI(i - 1) / N 
Next i 
End If 
End Function 

Public Function FFT1(AR() As Double, AI() As Double, N As Integer, ni As Integer) 
Dim i As Integer, j As Integer, k As Integer, L As Integer, M As Integer 
Dim IP As Integer, LE As Integer 
Dim L1 As Integer, N1 As Integer, N2 As Integer 
Dim SN As Double, TR As Double, TI As Double, WR As Double, WI As Double 
Dim UR As Double, UI As Double, US As Double 
M = NTOM(N) 
N2 = N / 2 
N1 = N - 1 
SN = ni 
j = 1 
For i = 1 To N1 
If i < j Then 
TR = AR(j) 
AR(j) = AR(i) 
AR(i) = TR 
TI = AI(j) 
AI(j) = AI(i) 
AI(i) = TI 
End If 
k = N2 
While (k < j) 
j = j - k 
k = k / 2 
Wend 
j = j + k 
Next i 
For L = 1 To M 
LE = 2 ^ L 
L1 = LE / 2 
UR = 1# 
UI = 0# 
WR = Cos(Pi / L1) 
WI = SN * Sin(Pi / L1) 
For j = 1 To L1 
For i = j To N Step LE 
IP = i + L1 
TR = AR(IP) * UR - AI(IP) * UI 
TI = AI(IP) * UR + AR(IP) * UI 
AR(IP) = AR(i) - TR 
AI(IP) = AI(i) - TI 
AR(i) = AR(i) + TR 
AI(i) = AI(i) + TI 
Next i 
US = UR 
UR = US * WR - UI * WI 
UI = UI * WR + US * WI 
Next j 
Next L 
If SN <> -1 Then 
For i = 1 To N 
AR(i) = AR(i) / N 
AI(i) = AI(i) / N 
Next i 
End If 
End Function 

Private Function NTOM(N As Integer) As Integer 
Dim ND As Double 
ND = N 
NTOM = 0 
While (ND > 1) 
ND = ND / 2 
NTOM = NTOM + 1 
Wend 
End Function 

'*使用********** 

Const fftIn = 128 
Dim i As Integer 
Dim xr(128) As Double 
Dim xi(128) As Double 

'赋值，IaIn(i)是采得的数据。 
For i = 0 To 128 
xr(i) = 100 * IaIn(i) 
xi(i) = 0 
Next 

'FFT变换 
Call FFT0(xr(), xi(), 128, 1) 

'绘图 
picI_FFT.Scale (0, 100)-(fftIn - 1, -10) 
picI_FFT.DrawWidth = 2 
For i = 0 To fftIn - 1 
picI_FFT.Line (i, Abs(xr(i)))-(i + 1, Abs(xr(i + 1))), vbBlue 
Next i