回复 3楼 约定的童话
你好 不是单独的用VB做FFT
而是用数据采集卡采集数据
对采集的数据做FFT蝶形运算 得到频率
下面是代码
求到的频率和实际值不符合 而且五秒左右变换一次频率
正常希望的是一秒做一次FFT 显示一次频率
Option Explicit
'*模块********************************************************
'FFT0 数组下标以0开始
'AR() 数据实部
AI() 数据虚部
'N 数据点数，为2的整数次幂
'NI 变换方向 1为正变换，-1为反变换
'***************************************************************
Public Jieguo() As Double
Const pi = 3.1415926
Public Function FFT0(AR() As Double, AI() As Double, n As Long, ni As Double)
Dim i As Long, j As Long, k As Long, L As Long, m As Long
Dim IP As Double, LE As Double
Dim L1 As Double, N1 As Double, N2 As Double
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
Private Function NTOM(n As Long) As Long
Dim ND As Single
ND = n
NTOM = 0
While (ND > 1)
ND = ND / 2
NTOM = NTOM + 1
Wend
End Function
Public Function GetArrayMax(a() As Double) As Double
Dim max As Double, min As Double, i As Integer
max = a(0)
min = a(0)
For i = 1 To UBound(a) - 1
If max < a(i) Then max = a(i)
If min > a(i) Then min = a(i)
Next i
GetArrayMax = max
End Function
Public Function SSSS()
Dim ii As Integer, nChannel As Integer, Index As Integer
Dim xr() As Double
Dim xi() As Double
Dim TongDaoShu As Integer, EveryTDPoint As Long
Dim arrmax As Double
Writelog "进入循环！"
Do While (bAIRun)
Do While (bAIRun)
If WaitForSingleObject(hEventDRAW, 10) = 0 Then
Exit Do
End If
Loop
'Status = WaitForSingleObject(hEventDRAW, INFINITE)
If bAIRun = False Then
Exit Function
End If
TongDaoShu = AD_Module.Para.nSampChanCount
EveryTDPoint = AD_Module.Para.nPointsPerChan
CurrentIndex = AD_Module.CurrentIndex
Writelog TongDaoShu & " - " & EveryTDPoint & " - " & CurrentIndex
ReDim xr(EveryTDPoint) As Double
ReDim xi(EveryTDPoint) As Double
For Index = 0 To EveryTDPoint - 1 Step 1
DoEvents
'Writelog Str(nChannel) + " " + Str(Index) + " " + Str(AD_Module.InUserRegion(nChannel + Index, CurrentIndex))
For nChannel = 0 To TongDaoShu - 1 Step 1
xr(Index) = AD_Module.InUserRegion(nChannel + Index, CurrentIndex)
xi(Index) = 0
Next nChannel
Call FFT0(xr(), xi(), EveryTDPoint, 1)
Next Index
arrmax = GetArrayMax(xr())
Writelog Str(arrmax)
AD_Form.TongDaoHz(nChannel - 1).Caption = arrmax
'
For Channel = 0 To TongDaoShu - 1 Step 1
'
Writelog Channel
'
ReDim xr(EveryTDPoint) As Long
'
ReDim xr(EveryTDPoint) As Long
'
DoEvents
'
For Index = 0 To EveryTDPoint * TongDaoShu - 1 Step TongDaoShu
'
DoEvents
'
xr(Index / TongDaoShu) = AD_Module.InUserRegion(Channel + Index, CurrentIndex)
'
xi(Index / TongDaoShu) = 0
'
Next Index
'
Call FFT0(xr(), xi(), EveryTDPoint, 1)
'
AD_Form.TongDaoHz(Channel).Caption = GetArrayMax(xr())
'
Next Channel
Writelog "完成循环！"
Loop
End Function
Public Sub Writelog(ByVal message As String)
'Write Error LogFile
'
Dim ifile As Long
'
ifile = FreeFile
'
Open App.Path & "\log\" & Format(Now, "YYYYMMDD") & ".txt" For Append As #ifile
'
Write #ifile, CStr(Now) & "---(): " & message
'
Close #ifile
End Sub
2022-03-27 20:10
