回复 80楼 ysr2857
（这个是我现在用的，我看了基本好像是差不多，有的应该是变量不同，麻烦有空帮忙看下错在哪里了
感激不尽！）
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-30 09:24
