求VB的FFT和FFT的反变换代码

求VB的FFT和FFT的反变换代码,第1张

晕 还有找快速傅立叶变换的

这个哥们博客有很多相关的

这个好像可以进行FFT和IFFT

前几天刚考完数字信号处理 学的这个晕啊

呵呵

这让悉个是FFT的

*模块********************************************************

'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

VB源程序如下:

Option Base 1

Private Sub Command1_Click()

Dim A(5, 5) As Integer, B(5, 5) As Integer

For x = 1 To 弊雀5

  For y = 1 To 5

      A(x, y) = Int(10 + Rnd * 乱卜慧90) '随机产生两位数的整数

      Print A(x, y) '输出

  Next

  Print

Next

Print

For x = 1 To 5

  For y = 1 To 5

      B(x, y) = A(y, x) '转置

      Print B(x, y) '输出

  Next

  Print

Next

End Sub

程序输出结果如下:

扩展资料:

VB:编写程序,实现如下规律的5*5矩阵哗答存入数组,并输出该数组

Private Sub Command1_Click()

Dim a(1 To 6, 1 To 6) As Integer

For i = 1 To 5

For j = 1 To 5

tmp = 99

If i <tmp Then

tmp = i

End If

If j <tmp Then

tmp = j

End If

If 6 - i <tmp Then

tmp = 6 - i

End If

If 6 - j <tmp Then

tmp = 6 - j

End If

a(i, j) = tmp

Next j

Next i

For i = 1 To 5

For j = 1 To 5

Picture1.Print Tab(j * 5)a(i, j)

Next j

Picture1.Print

Next i

End Sub

程序输出结果如下:


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/yw/8178170.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-04-14
下一篇 2023-04-14

发表评论

登录后才能评论

评论列表(0条)

保存