frmmain.frm

FFT Demo Program. Written in VB

VERSION 5.00
Begin VB.Form frmMain 
   Caption         =   "FFTdemo"
   ClientHeight    =   7980
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   8550
   LinkTopic       =   "Form1"
   ScaleHeight     =   532
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   570
   StartUpPosition =   3  'Windows Default
   WindowState     =   2  'Maximized
   Begin VB.CommandButton CmdDone 
      Caption         =   "Done"
      Height          =   255
      Left            =   2280
      TabIndex        =   14
      Top             =   7560
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.TextBox TxtLowFreq 
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   5160
      TabIndex        =   10
      Top             =   720
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.TextBox TxtHighFreq 
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   5160
      TabIndex        =   9
      Top             =   1080
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.DriveListBox DriveSetup 
      Height          =   315
      Left            =   0
      TabIndex        =   2
      Top             =   2640
      Visible         =   0   'False
      Width           =   2655
   End
   Begin VB.DirListBox DirSetup 
      Height          =   4365
      Left            =   0
      TabIndex        =   1
      Top             =   3000
      Visible         =   0   'False
      Width           =   2655
   End
   Begin VB.FileListBox FileSetup 
      Height          =   4380
      Left            =   2880
      Pattern         =   "*.wav"
      TabIndex        =   0
      Top             =   3000
      Visible         =   0   'False
      Width           =   1695
   End
   Begin VB.Label LabMsg 
      AutoSize        =   -1  'True
      Caption         =   "Label1"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   3720
      TabIndex        =   13
      Top             =   7560
      Visible         =   0   'False
      Width           =   585
   End
   Begin VB.Label LabLowFreq 
      AutoSize        =   -1  'True
      Caption         =   "Low freq."
      Height          =   195
      Left            =   4320
      TabIndex        =   12
      Top             =   750
      Visible         =   0   'False
      Width           =   660
   End
   Begin VB.Label LabHighFreq 
      AutoSize        =   -1  'True
      Caption         =   "High freq."
      Height          =   195
      Left            =   4320
      TabIndex        =   11
      Top             =   1110
      Visible         =   0   'False
      Width           =   270
   End
   Begin VB.Label LabFile 
      AutoSize        =   -1  'True
      Caption         =   "File"
      Height          =   195
      Left            =   120
      TabIndex        =   8
      Top             =   1800
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Label LabRate 
      AutoSize        =   -1  'True
      Caption         =   "Rate"
      Height          =   195
      Left            =   120
      TabIndex        =   7
      Top             =   480
      Visible         =   0   'False
      Width           =   345
   End
   Begin VB.Label LabChans 
      AutoSize        =   -1  'True
      Caption         =   "Channels"
      Height          =   195
      Left            =   120
      TabIndex        =   6
      Top             =   240
      Visible         =   0   'False
      Width           =   660
   End
   Begin VB.Label LabSec 
      AutoSize        =   -1  'True
      Caption         =   "Seconds"
      Height          =   195
      Left            =   120
      TabIndex        =   5
      Top             =   1200
      Visible         =   0   'False
      Width           =   630
   End
   Begin VB.Label LabBits 
      AutoSize        =   -1  'True
      Caption         =   "Bits per sample"
      Height          =   195
      Left            =   120
      TabIndex        =   4
      Top             =   720
      Visible         =   0   'False
      Width           =   1065
   End
   Begin VB.Label LabSamps 
      AutoSize        =   -1  'True
      Caption         =   "Total samples"
      Height          =   195
      Left            =   120
      TabIndex        =   3
      Top             =   960
      Visible         =   0   'False
      Width           =   975
   End
   Begin VB.Menu mnuGetWav 
      Caption         =   "Get WAV file"
   End
   Begin VB.Menu mnuDigFlt 
      Caption         =   "Digital Filter"
      Enabled         =   0   'False
   End
   Begin VB.Menu mnuFFT 
      Caption         =   "Do FFT"
      Enabled         =   0   'False
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim strHeader As String * 12
Dim strFormat As String * 4
Dim strByte As String * 1
Dim lngNumDataBytes As Long
Dim sngTemp As Single
Dim lngTemp As Long
Dim Msg As String
Dim strPath As String
Dim strFile As String

Private Sub DigitalFilter()
Dim Index As Long, lngTemp As Long
Dim lngEnd As Long, lngStart As Long
Dim lngQuan As Long, lngSamp As Long
Dim Outer As Long, Ntodo As Integer, Quan As Integer, Samp As Integer
    gstrRoutine = "DigitalFilter"
    On Error GoTo ErrorHandler  ' Enable error-handling routine.
    sngTemp = gintResolution
    TxtLowFreq.Text = ""
    LabLowFreq.Visible = True
    TxtLowFreq.Visible = True
    TxtLowFreq.SetFocus
    gblnRetFlg = False
RETRYLOW:
    DoEvents
    If Not gblnRetFlg Then GoTo RETRYLOW
REDOHIGH:
    lngStart = CLng(TxtLowFreq.Text)
    TxtHighFreq.Text = ""
    LabHighFreq.Visible = True
    TxtHighFreq.Visible = True
    TxtHighFreq.SetFocus
    gblnRetFlg = False
RETRYHIGH:
    DoEvents
    If Not gblnRetFlg Then GoTo RETRYHIGH
    lngEnd = CLng(TxtHighFreq.Text)
    If lngEnd > (sngTemp / 2#) Then GoTo REDOHIGH
    glngFFTItems = 8192
    For Index = 1 To 5
        If glngFFTItems > glngMaxCount Then GoTo OKAY
        glngFFTItems = glngFFTItems * 2
    Next Index
OKAY:

    gsngFreqPerPoint = sngTemp / CSng(glngFFTItems)
    lngStart = lngStart / gsngFreqPerPoint
    lngEnd = lngEnd / gsngFreqPerPoint
    If lngStart > lngEnd Then       'if entered in reverse
        lngTemp = lngStart
        lngStart = lngEnd
        lngEnd = lngTemp
    End If
    ReDim gsngRLEDAT(glngFFTItems - 1)
    ReDim gsngRLEIMG(glngFFTItems - 1)
    ReDim gsngFFTSIN(glngFFTItems - 1)
    ReDim gsngFFTCOS(glngFFTItems - 1)
    Screen.MousePointer = vbHourglass
    For Index = 0 To glngMaxCount - 1
        gsngRLEDAT(Index) = gintPlot(Index)
    Next Index
    For Index = glngMaxCount To glngFFTItems - 1
        gsngRLEDAT(Index) = 0#
    Next Index
    gbytRepeat = 0
    gblnInverse = False
    Call FastFourierTransform
    lngQuan = lngStart
    lngSamp = 0
    Call ZeroArrays(lngQuan, lngSamp)
    lngSamp = glngFFTItems - lngStart
    Call ZeroArrays(lngQuan, lngSamp)
    lngQuan = ((glngFFTItems / 2) - lngEnd) * 2
    lngSamp = lngEnd
    Call ZeroArrays(lngQuan, lngSamp)
    gbytRepeat = 1
    gblnInverse = True
    Call FastFourierTransform
    Call DoSmoothing(glngMaxCount)
    Call FixAmplitude(glngMaxCount)
    For Index = 0 To glngMaxCount - 1
        gintPlot(Index) = gsngRLEDAT(Index)
    Next Index
    gintPlot(0) = gintPlot(1)
    
    LabLowFreq.Visible = False
    TxtLowFreq.Visible = False
    LabHighFreq.Visible = False
    TxtHighFreq.Visible = False
    ReDim gsngRLEDAT(0)
    ReDim gsngRLEIMG(0)
    ReDim gsngFFTSIN(0)
    ReDim gsngFFTCOS(0)
    Screen.MousePointer = vbArrow

Exit Sub        ' Exit to avoid handler.
ErrorHandler:   ' Error-handling routine.
    If Err.Number <> 0 Then Call ErrorMsg
    Resume ENDERROR

ENDERROR:
    Close #1
    Close 2
    MousePointer = vbArrow
    
End Sub


Private Sub CmdDone_Click()
    gblnRetFlg = True
    
End Sub

Private Sub DirSetup_Change()
    strPath = DirSetup.Path & "\"   ' Get file path.
    FileSetup.Path = DirSetup.Path

End Sub