frmfft.frm

利用VB进行FFT（快速傅立叶）变换。

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5880
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6915
   LinkTopic       =   "Form1"
   ScaleHeight     =   5880
   ScaleWidth      =   6915
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdin 
      Caption         =   "Command1"
      Height          =   435
      Left            =   2310
      TabIndex        =   4
      Top             =   120
      Width           =   2355
   End
   Begin VB.PictureBox pic2 
      Height          =   5115
      Left            =   3450
      ScaleHeight     =   5055
      ScaleWidth      =   3255
      TabIndex        =   3
      Top             =   720
      Width           =   3315
   End
   Begin VB.PictureBox pic1 
      Height          =   5115
      Left            =   30
      ScaleHeight     =   5055
      ScaleWidth      =   3255
      TabIndex        =   2
      Top             =   720
      Width           =   3315
   End
   Begin VB.TextBox txtTs 
      Height          =   405
      Left            =   4800
      TabIndex        =   1
      Top             =   150
      Width           =   1875
   End
   Begin VB.TextBox txtm 
      Height          =   405
      Left            =   240
      TabIndex        =   0
      Top             =   150
      Width           =   1875
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdin_Click()
    Dim m As Integer
    Dim nn As Integer
    Dim n As Integer
    Dim ts As Double
    
    m = Val(txtm.Text)
    ts = Val(txtTs.Text)
    nn = 2 ^ m
    n = nn - 1
    ReDim ar(n)
    ReDim ai(n)
    ReDim xr(n)
    ReDim xi(n)
    
    Open "f:\1111.txt" For Append As #1
    For i = 0 To n
        t = i * ts
        xr(i) = f(t): xi(i) = g(t)
        ar(i) = xr(i): ai(i) = xi(i)
        pic1.Print "xr("; i; ")="; Format(xr(i), "####.###"); _
        "xi("; i; ")="; Format(xi(i), "####.###")
    Next i
    Close #1
    lh = nn / 2
    j = lh
    n1 = nn - 2
    For i = 1 To n1
        If (i < j) Then
            t1 = xr(i): ar(i) = xr(j): ar(j) = t1
            t2 = xr(i): ai(i) = xi(j): ai(j) = t2
        Else
        End If
        k = lh
        While j >= k
            j = j - k: k = k / 2
        Wend
        
        j = j + k
    Next i
    c = 2 * 3.14159 / nn
    For l = 1 To m
        b = 2 ^ (l - 1)
        For j = 0 To b - 1
            p = 2 ^ (m - l) * j
            t = c * p
            For k = j To n Step 2 ^ l
                cs = Cos(t): sn = Sin(t)
                tr = ar(k + b) * cs + ai(k + b) * sn
                ti = ai(k + b) * cs - ar(k + b) * sn
                ar(k + b) = ar(k) - tr
                ai(k + b) = ai(k) - ti
                ar(k) = ar(k) + tr
                ai(k) = ai(k) + ti
            Next k
        Next j
    Next l
    
    Open "f:\1112.txt" For Output As #2
        For i = 0 To n
            pic2.Print "Xr("; i; ")="; Format(ai(i), "####.###")
        Next i
    Close #2
End Sub
    
Private Function f(ByVal t As Double) As Double
    f = Sin(t)
End Function

Private Function g(ByVal t As Double) As Double
    g = Cos(t)
End Function