Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
ReDim xr(0 To Len(a) - 1): ReDim yr(0 To Len(b) - 1): ReDim zr(0 To Len(b) - 1)
For i1 = 0 To Len(a) - 1
xr(i1) = Mid(a, i1 + 1, 1)
yr(i1) = Mid(b, i1 + 1, 1)
Next
Dim l As Long, le As Long, le1 As Long, n As Long, r As Long, p As Long, q As Long, m As Byte
Dim wr As Double, w1 As Double, wlr As Double, wl1 As Double, tr As Double, t1 As Double
Dim pi As Double, t As Double, tr1 As Double
Dim xi(): Dim yi(): Dim zi()
n = Len(a) '求数组大小，其值必须是2的幂
m = 0
l = 2
pi = 3.14159265358979
Do
l = l + l
m = m + 1
Loop Until l > n
n = l / 2
ReDim xi(n - 1): ReDim yi(n - 1): ReDim zi(n - 1)
l = 1
Do
le = 2 ^ l
le1 = le / 2
wr = 1
wi = 0
t = pi / le1
w1r = Cos(t)
w1i = -Sin(t)
r = 0
Do
p = r
Do
q = p + le1
tr = xr(q) * wr - xi(q) * wi
ti = xr(q) * wi + xi(q) * wr
tr1 = yr(q) * wr - yi(q) * wi
ti1 = yr(q) * wi + yi(q) * wr
xr(q) = xr(p) - tr
xi(q) = xi(p) - ti
xr(p) = xr(p) + tr
xi(p) = xi(p) + ti
yr(q) = yr(p) - tr1
yi(q) = yi(p) - ti1
yr(p) = yr(p) + tr1
yi(p) = yi(p) + ti1
p = p + le
Loop Until p > n - 1
wr = wr * w1r - wi * w1i
wi = wr * w1i + wi * w1r
r = r + 1
Loop Until r > le1 - 1
l = l + 1
Loop Until l > m
For i = 0 To n - 1 '仅输出模
zr(i) = xr(i) * yr(i) - xi(i) * yi(i): zi(i) = xr(i) * yi(i) + xi(i) * yr(i)
If InStr(zr(i), ".") = 0 Then
zr(i) = zr(i)
Else
a1 = Left(zr(i), InStr(zr(i), ".") - 1)
b1 = Mid(zr(i), InStr(zr(i), "."), 3)
zr(i) = a1 & b1
End If
If InStr(zi(i), ".") = 0 Then
zi(i) = zi(i)
Else
a2 = Left(zi(i), InStr(zi(i), ".") - 1)
b2 = Mid(zi(i), InStr(zi(i), "."), 3)
zi(i) = a2 & b2
End If
s = "/" & zr(i) & s
s1 = "/" & zi(i) & s1
Next
s2 = nifft(Trim(s), Trim(s1))
Text2 = s2
End Sub
Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
End Sub
Private Function nifft(sa As String, sb As String) As String
Dim l As Long, le As Long, le1 As Long, j As Long, r As Long, p As Long, q As Long, m As Byte
Dim wr As Double, w1 As Double, wlr As Double, wl1 As Double, tr As Double, t1 As Double
Dim pi As Double, t As Double, tr1 As Double
Dim xi(): Dim yi(): Dim zi()
Dim xr(), yr(), zr()
s2 = Split(sa, "/")
s3 = Split(sb, "/")
j = UBound(s2)
n = j
For k = 1 To j
n1 = n1 + 1
ReDim Preserve xr(0 To n1 - 1)
ReDim Preserve yr(0 To n1 - 1)
xr(n1 - 1) = s2(n1): yr(n1 - 1) = s3(n1)
Next
ReDim zr(0 To j - 1)
m = 0
l = 2
pi = 3.14159265358979
Do
l = l + l
m = m + 1
Loop Until l > n
n = l / 2
ReDim xi(n - 1): ReDim yi(n - 1): ReDim zi(n - 1)
l = 1
Do
le = 2 ^ l
le1 = le / 2
wr = 1
wi = 0
t = pi / le1
w1r = Cos(t)
w1i = -Sin(t)
r = 0
Do
p = r
Do
q = p + le1
tr = xr(q) * wr - xi(q) * wi
ti = xr(q) * wi + xi(q) * wr
tr1 = yr(q) * wr - yi(q) * wi
ti1 = yr(q) * wi + yi(q) * wr
xr(q) = xr(p) - tr
xi(q) = xi(p) - ti
xr(p) = xr(p) + tr
xi(p) = xi(p) + ti
yr(q) = yr(p) - tr1
yi(q) = yi(p) - ti1
yr(p) = yr(p) + tr1
yi(p) = yi(p) + ti1
p = p + le
Loop Until p > n - 1
wr = wr * w1r - wi * w1i
wi = wr * w1i + wi * w1r
r = r + 1
Loop Until r > le1 - 1
l = l + 1
Loop Until l > m
For i = 0 To n - 1 '仅输出模
zr(i) = xr(i) + yr(i)
If InStr(zr(i), ".") = 0 Then
zr(i) = zr(i)
Else
a1 = Left(zr(i), InStr(zr(i), ".") - 1)
b1 = Mid(zr(i), InStr(zr(i), "."), 3)
zr(i) = a1 & b1
End If
s1 = Int(Val(zr(i) + 0.5))
s = "/" & s1 & s
Next
nifft = s
End Function
输入：Text1 =80607000，Text2=20403000,结果：
/48/30/38/-159/43/-31/54/237
与正确值比较：0, 0, 0, 24, 46, 65, 38, 16也是不对。
