audiofft.bas

一个用VB编写的双音多频识别程式(运用傅里叶变换算法)

Attribute VB_Name = "AudioFFT"
'----------------------------------------------------------------------
' Audio FFT
'----------------------------------------------------------------------
' This code is basically a stripped-down and ironed-out version of
' my VB FFT Library (available on the Deeth website) done entirely
' with digital audio in mind.
' My VB FFT Library (and thusly -- this as well) is heavily based on
' Don Cross's FFT code.
' Check his website at http://www.intersrv.com/~dcross/fft.html for
' more information.
'----------------------------------------------------------------------
' Murphy McCauley ([e-mail]) 08/14/99
' http://www.fullspectrum.com/deeth/
'----------------------------------------------------------------------


Option Explicit

'These don't change in this program, so I made them constants so they're
'as fast as can be.
Public Const AngleNumerator = 6.283185   ' 2 * Pi = 2 * 3.14159265358979
Public Const NumSamples = 1024
Public Const NumBits = 10

'Used to store pre-calculated values
Private ReversedBits(0 To NumSamples - 1) As Long
Private Hann(0 To NumSamples - 1) As Long
Private OldOut(0 To NumSamples - 1) As Single
Private OldOut2(0 To NumSamples - 1) As Single
Private Goer(0 To NumSamples - 1) As Single






Sub DoReverse()
    'I pre-calculate all these values.  It's a lot faster to just read them from an
    'array than it is to calculate 1024 of them every time FFTAudio() gets called.
    Dim i As Long
    For i = LBound(ReversedBits) To UBound(ReversedBits)
        ReversedBits(i) = ReverseBits(i, NumBits)
        OldOut(i) = 1
        OldOut2(i) = 1
        Goer(i) = (AngleNumerator * i) / 1024
    Next
    
End Sub

Function ReverseBits(ByVal Index As Long, NumBits As Byte) As Long
    Dim i As Byte, Rev As Long
    
    For i = 0 To NumBits - 1
        Rev = (Rev * 2) Or (Index And 1)
        Index = Index \ 2
    Next
    
    ReverseBits = Rev
End Function

Sub FFTAudio(RealIn() As Integer, RealOut() As Single)
    'In this case, NumSamples isn't included (since it's always the same),
    'and the imaginary components are left out since they have no meaning here.
    
    'I've used Singles instead of Doubles pretty much everywhere.  I think this
    'makes it faster, but due to type conversion, it actually might not.  I should
    'check, but I haven't.
    
    'The imaginary components have no meaning in this application.  I just left out
    'the parts of the calculation that need the imaginary input values (which is a
    'big speed improvement right there), but we still need the output array because
    'it's used in the calculation.  It's static so that it doesn't get reallocated.
    Static ImagOut(0 To NumSamples - 1) As Single
    
    'In fact... I declare everything as static!  They all get initialized elsewhere,
    'and Staticing them saves from wasting time reallocating and takes pressure off
    'the heap.
    Static i As Long, j As Long, k As Long, n As Long, BlockSize As Long, BlockEnd As Long
    Static DeltaAngle As Single, DeltaAr As Single
    Static Alpha As Single, Beta As Single
    Static TR As Single, TI As Single, AR As Single, AI As Single
    Static z As Long
    
    
    For i = 0 To (NumSamples - 1)
        j = ReversedBits(i) 'I saved time here by pre-calculating all these values
         RealOut(j) = (RealIn(i) * Hann(i))
         ImagOut(j) = 0 'Since this array is static, gotta make sure it's clear
    Next

    BlockEnd = 1
    BlockSize = 2

    Do While BlockSize <= NumSamples
        DeltaAngle = AngleNumerator / BlockSize
        Alpha = Sin(0.54 * DeltaAngle)
        Alpha = 2! * Alpha * Alpha
        Beta = Sin(DeltaAngle)
        
        i = 0
        Do While i < NumSamples
            AR = 1!
            AI = 0!
            
            j = i
            For n = 0 To BlockEnd - 1
                k = j + BlockEnd
                TR = AR * RealOut(k) - AI * ImagOut(k)
                TI = AI * RealOut(k) + AR * ImagOut(k)
                RealOut(k) = RealOut(j) - TR
                ImagOut(k) = ImagOut(j) - TI
                RealOut(j) = RealOut(j) + TR
                ImagOut(j) = ImagOut(j) + TI
                DeltaAr = Alpha * AR + Beta * AI
                AI = AI - (Alpha * AI - Beta * AR)
                AR = AR - DeltaAr
                j = j + 1
            Next
            
            i = i + BlockSize
        Loop
        
        BlockEnd = BlockSize
        BlockSize = BlockSize * 2
    Loop

End Sub



Public Sub Hanning()
'Pre calculate a Hanning window....
Dim i As Long
Dim twopi As Long
twopi = 8# * Atn(1#)

For i = LBound(Hann) To UBound(Hann)
   'Hann(i) = 0.5 - (0.5 * Cos(twopi * i / NumSamples))
   'Hann(i) = Sin(3.14159265 * i / NumSamples)
   Hann(i) = 1
Next

'For i = LBound(Hann) To UBound(Hann)
'    Hann(i) = 0.355768 - 0.487396 * Cos(AngleNumerator * i / NumSamples) + 0.144232 * Cos(4 * 3.14159265 * i / NumSamples) - 0.012604 * Cos(6 * 3.14159265 * i / NumSamples)
'Next

End Sub