vb-fft.txt

This program produces a Frequency Domain display from the Time Domain * data input using the Fast

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