GFFrequencyAnalyzer/GFFrequencyAnalyzermod.bas

Attribute VB_Name = "GFFrequencyAnalyzermod"
Option Explicit
'(c)2003 by Louis. Original Louis Coder code (c)1999 by Murphy McCauley.
'Original Murphy McCauley code (c) by Don Cross.
'
'NOTE: CODE DOES NOT WORK CORRECTLY YET!
'
#Const GFFADLLExistingFlag = False
'
'Oringinal Muphy McCauley code comment:
'>>>
'‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑
' 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 (MurphyMc@Concentric.NET) 08/14/99
' http://www.fullspectrum.com/deeth/
'‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑‑
'<<<
'End of original Murphy McCauley code comment.
'
'Note that this code was heavily improved by Louis Coder and mainly
'uses the public FFT algorithm.
'
'NOTE: view GFMicrophoneToArray for a sample program that uses this module.
'NOTE: orignal comment by Louis Coder:
'"I know that it works but I don't know how. Viva Ctrl‑C Ctrl‑V!".
'
'As the Murphy code went a lot through www.pscode.com there are some further
'comments on that code, of of them is the following (see Audio Ripper spectrum
'analyzer sample):
'
'>>>
' Now, to explain exactly how this program works.
' Basically what it does is it continuously reads
' the volume of the speakers and puts the values it reads
' into an array of size 128. It then runs a function on these
' values, a function called a Fast Fourier Transform(FFT) which
' is a fast version of the Discrete Fourier Transform. This
' function returns, in the output array, the strength of
' seperate frequencies of sound. The first element of the
' output array is the average volume. The way to figure out
' which frequency element x refers to is by (x * sampling rate)/number of samples
' In the case of good audio it is  (x * 44100 Hz)/ 128, or x * 344.5 Hz

' If you would like a bit of background, you can read this paragraph
' The FFT was designed based on the discovery that you can turn
' any function of time, x(t), into a sum of an infinite number of
' sine and cosine waves. The equation that resulted was:
' x(t) = a[0] + {{sum, from 1 to infinity of}} {a[k]*sin(2*pi*frequency*t) + b[k]*cos(2*pi*frequency*t)}
' The job of the fourier transform function is to figure out all of
' the a[k]s and all of the b[k]s. Sounds horrible, doesn't it.

' Also, you will note that this spectrum analysis does not
' look exactly like Winamp's. This is mostly because Winamp's
' is not evenly spaced, Winamp concentrates on the frequencies
' in the 60Hz to 1KHz range. Winamp also uses extra 'tricks' with
' its equalizer when doing its spectrum analysis. This analysis
' easily runs at 350fps on my computer, so it should be able
' to fit into someones audio player if you wish to use it.
'<<<
'
'GFFADLL API functions
Private Declare Sub GFFADLL_Test Lib "GFFADLL.dll" (ByRef SinArray As Any)
Private Declare Sub GFFADLL_GetSpectrumArray Lib "GFFADLL.dll" (ByRef InputArray As AnyByRef SpectrumArray As AnyByVal SpectrumArraySize As LongByRef ReversedBitArray As AnyByVal FilterBits As Long)
'GFFA_MicrophoneArrayToSpectrumArray
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As AnyByVal cbCopy As Long)
'public constants
Public Const GFFA_FILTERBIT_NOFILTER As Long = 0
Public Const GFFA_FILTERBIT_HANNINGFILTER As Long = 1
'private vonstants
Private Const TWO_PI As Double = 6.28318530717959 '2 * Pi = 2 * 3.14159265358979
'other
Dim ReversedBitArray() As Long
Dim ReversedBitNumber As Long
Dim SpectrumArraySizeOld As Long

'***INTERFACE SUBS***
'NOTE: use GFFA_GetSpectrumArray() to convert wave data gotten from
'GFMicrophoneToArray into 'spectrum data' stored in the SpectrumArray().
'The spectrum array dimensions are variable.
'You must have recorded at least SpectrumArraySize bytes. If wanting to
'have a better time resolution (getting the spectrum for smaller time windows)
'then make the inputted audio data overlap so that only the first few
'thousand bytes or so are new.
'The frequency resolution of the SpecrumArray() is rather good, you can
'calculate the frequency represented by one array item using a formula
'(see procedure code). The output range or unit is unknown, just try it out.
'Try out also further samples in this module's sub directories.
'The Hanning filter should be enabled as then the output looks less 'chaotic',
'even if the exact purpose of the filter is unknown.
'View Audio Analyzer and related General Function directories for further
'development infos.

Public Sub GFFA_GetSpectrumArray(ByRef InputArray() As IntegerByRef SpectrumArray() As DoubleByVal SpectrumArraySize As LongByVal FilterBits As Long)
    'on error resume next 'put in amplitude data and the code will initialize SpectrumArray() with the frequency 'strength'
    Dim Temp As Long
    'preset
    If Not (SpectrumArraySizeOld = SpectrumArraySize) Then
        Select Case SpectrumArraySize 'NOTE: use a power of two only or the FFT algorithm will fail (read in a book)...
        Case 128&
            ReDim ReversedBitArray(0 To (SpectrumArraySize ‑ 1&)) As Long
            ReversedBitNumber = 7&
        Case 256&
            ReDim ReversedBitArray(0 To (SpectrumArraySize ‑ 1&)) As Long
            ReversedBitNumber = 8&
        Case 512&
            ReDim ReversedBitArray(0 To (SpectrumArraySize ‑ 1&)) As Long
            ReversedBitNumber = 9&
        Case 1024&
            ReDim ReversedBitArray(0 To (SpectrumArraySize ‑ 1&)) As Long
            ReversedBitNumber = 10&
        Case 2048&
            ReDim ReversedBitArray(0 To (SpectrumArraySize ‑ 1&)) As Long
            ReversedBitNumber = 11&
        Case 4096&
            ReDim ReversedBitArray(0 To (SpectrumArraySize ‑ 1&)) As Long
            ReversedBitNumber = 12&
        Case 8192&
            ReDim ReversedBitArray(0 To (SpectrumArraySize ‑ 1&)) As Long
            ReversedBitNumber = 13&
        Case 16384&
            ReDim ReversedBitArray(0 To (SpectrumArraySize ‑ 1&)) As Long
            ReversedBitNumber = 14&
        Case 32768
            ReDim ReversedBitArray(0 To (SpectrumArraySize ‑ 1&)) As Long
            ReversedBitNumber = 15&
        Case 65536
            ReDim ReversedBitArray(0 To (SpectrumArraySize ‑ 1&)) As Long
            ReversedBitNumber = 16&
        Case 131072
            ReDim ReversedBitArray(0 To (SpectrumArraySize ‑ 1&)) As Long
            ReversedBitNumber = 17&
        Case Else
            MsgBox "internal error in GFFA_GetSpectrumArray() (GFFrequencyAnalyzer): SpectrumArraySize not supported !", vbOKOnly + vbExclamation
            Exit Sub
        End Select
        For Temp = LBound(ReversedBitArray()) To UBound(ReversedBitArray())
            ReversedBitArray(Temp) = GFFA_ReverseBits(Temp, ReversedBitNumber)
        Next Temp
    End If
    SpectrumArraySizeOld = SpectrumArraySize
    'begin
    #If GFFADLLExistingFlag = True Then
        'GFFADLL
        '
        'NOTE: we call the VC++ procedure as it is MUCH faster than the VB procedure.
        'The VC++ procedure does exactly the same as this sub (except static var declaration),
        'but in C.
        '
        'NOTE: no idea what this Hanning filter is good for, but one sample program used it
        'and worked better than mine without it. View \Developing Notes for the formula.
        'Only the C code can use the Hanning filter, no implementation for this VB code
        '(in this procedure). Note that the stuff works MUCH better with this filter, without
        'there are permanent high amplitudes in the low frequencies.
        '
        'NOTE: the formula to determine the current frequency from the SpectrumArray()
        'index (SPI) is the following:
        'f = SampleRate * SPI / SpectrumArraySize
        'For example (for the test project GFMicrophoneToArray):
        'f = 44100 1/s * 100 / 65536 = 269 Hz
        'You can use GFFA_SpectrumArrayIndexToFrequency() to do the conversion
        'using code.
        '
        Call GFFADLL_GetSpectrumArray(InputArray(0), SpectrumArray(0), SpectrumArraySize, ReversedBitArray(0), FilterBits)
        'END OF GFFADLL
    #Else
        Call GFFAVB_GetSpectrumArray(InputArray(), SpectrumArray(), SpectrumArraySize, ReversedBitArray())
    #End If
    Exit Sub
End Sub

Private Sub GFFAVB_GetSpectrumArray(ByRef InputArray() As IntegerByRef SpectrumArray() As DoubleByVal SpectrumArraySize As LongByRef ReversedBitArray() As Long)
    'on error resume next 'slower than the VC++ version, but implemented for debugging and testing
    Static BlockSize As Long ''Static' was in DEBUG_Test by around 10 percent faster than 'Dim'
    Static BlockEndPos As Long
    Static DeltaAngle As Double
    Static DeltaAR As Double
    Static Alpha As Double
    Static Beta As Double
    Static TR As Double
    Static TI As Double
    Static AR As Double
    Static AI As Double
    Static TempSpectrumArray() As Double
    Static Temp1 As Long
    Static Temp2 As Long
    Static Temp4 As Long
    Static Temp3 As Long
    'preset
    ReDim TempSpectrumArray(0 To (SpectrumArraySize ‑ 1&)) As Double
    For Temp1 = 0& To (SpectrumArraySize ‑ 1&)
        SpectrumArray(ReversedBitArray(Temp1)) = InputArray(Temp1)
        TempSpectrumArray(Temp1) = 0& 'since this array is static, gotta make sure it's clear
        'ReversedBitArray(Temp1) 'note that using Temp1 instead of ReversedBitArray(Temp1) above has the same effect and is faster (differs from original code)
    Next
    'begin
    '
    BlockEndPos = 1&
    BlockSize = 2&
    '
    Do While BlockSize <= SpectrumArraySize
        '
        DeltaAngle = TWO_PI / BlockSize
        Alpha = Sin(0.5 * DeltaAngle)
        Alpha = 2# * Alpha * Alpha
        Beta = Sin(DeltaAngle)
        Temp1 = 0& 'reset
        '
        Do While Temp1 < SpectrumArraySize
            '
            AR = 1#
            AI = 0#
            '
            Temp2 = Temp1 'preset
            For Temp3 = 0& To (BlockEndPos ‑ 1&)
                Temp4 = Temp2 + BlockEndPos
                TR = AR * SpectrumArray(Temp4) ‑ AI * TempSpectrumArray(Temp4)
                TI = AI * SpectrumArray(Temp4) + AR * TempSpectrumArray(Temp4)
                SpectrumArray(Temp4) = SpectrumArray(Temp2) ‑ TR
                TempSpectrumArray(Temp4) = TempSpectrumArray(Temp2) ‑ TI
                SpectrumArray(Temp2) = SpectrumArray(Temp2) + TR
                TempSpectrumArray(Temp2) = TempSpectrumArray(Temp2) + TI
                DeltaAR = Alpha * AR + Beta * AI
                AI = AI ‑ (Alpha * AI ‑ Beta * AR)
                AR = AR ‑ DeltaAR
                Temp2 = Temp2 + 1&
            Next Temp3
            Temp1 = Temp1 + BlockSize
        Loop
        '
        BlockEndPos = BlockSize
        BlockSize = BlockSize * 2&
        '
    Loop
End Sub

Public Sub GFFA_SmoothSpectrumArray(ByRef SpectrumArray() As DoubleByVal SmoothRadius As Long)
    'on error resume next 'removes sinus waves, etc. from spectrum array just by averaging values of a defined frequency window (length = 2 * SmoothRadius + 1)
    Dim SpectrumArrayLBound As Long
    Dim SpectrumArrayUBound As Long
    Dim SmoothStartIndex As Long
    Dim SmoothCenterIndex As Long
    Dim SmoothEndIndex As Long
    Dim TempSpectrumArray() As Double
    Dim Temp1 As Long
    Dim Temp2 As Long
    'preset
    SpectrumArrayLBound = LBound(SpectrumArray())
    SpectrumArrayUBound = UBound(SpectrumArray())
    ReDim TempSpectrumArray(SpectrumArrayLBound To SpectrumArrayUBound) As Double
    'verify
    Select Case SmoothRadius
    Case Is < 1&
        SmoothRadius = 1&
    Case Is > SpectrumArrayUBound
        SmoothRadius = SpectrumArrayUBound
    End Select
    'begin
    For Temp1 = SpectrumArrayLBound To SpectrumArrayUBound
        '
        SmoothStartIndex = MAX(SpectrumArrayLBound, Temp1 ‑ SmoothRadius)
        'SmoothCenterIndex = Temp1 'not in use
        SmoothEndIndex = MIN(SpectrumArrayUBound, Temp1 + SmoothRadius)
        '
        For Temp2 = SmoothStartIndex To SmoothEndIndex
            TempSpectrumArray(Temp1) = TempSpectrumArray(Temp1) + SpectrumArray(Temp2)
        Next Temp2
        TempSpectrumArray(Temp1) = TempSpectrumArray(Temp1) / CDbl(SmoothEndIndex ‑ SmoothStartIndex)
        '
    Next Temp1
    Call CopyMemory(SpectrumArray(SpectrumArrayLBound), TempSpectrumArray(SpectrumArrayLBound), (SpectrumArrayUBound ‑ SpectrumArrayLBound + 1&) * 8&) 'Double has 8 bytes
End Sub

Public Sub GFFA_EqualLoudness(ByRef SpectrumArray() As DoubleByVal TriggerValue As Double)
    'on error resume next 'when there's at least one value in SpectrumArray() that exceeds TriggerValue * 1024000 then the 'loudness level' is raised or lowered so that the highest value is 1024000
    Dim AmplitudeValueMax As Double
    Dim AmplitudeValueMultiplier As Double
    Dim SpectrumArrayLBound As Long
    Dim SpectrumArrayUBound As Long
    Dim Temp As Long
    'begin
    '
    SpectrumArrayLBound = LBound(SpectrumArray())
    SpectrumArrayUBound = UBound(SpectrumArray())
    '
    For Temp = SpectrumArrayLBound To SpectrumArrayUBound
        '
        If (SpectrumArray(Temp) / 1024000#) > AmplitudeValueMax Then
            AmplitudeValueMax = (SpectrumArray(Temp) / 1024000#)
        End If
        '
    Next Temp
    '
    If AmplitudeValueMax < TriggerValue Then Exit Sub 'nothing to do
    AmplitudeValueMultiplier = 1! / AmplitudeValueMax
    '
    For Temp = SpectrumArrayLBound To SpectrumArrayUBound
        '
        SpectrumArray(Temp) = SpectrumArray(Temp) * AmplitudeValueMultiplier
        '
    Next Temp
    '
End Sub

Public Sub GFFA_MicrophoneArrayToSpectrumArray(ByRef MicrophoneArray() As IntegerByRef SpectrumArray() As DoubleByVal SpectrumArraySize As Long)
    'on error resume next 'this sub is to be used in combination with GFMicrophoneToArray
    '
    'NOTE: for compatibility with older target projects MicrophoneArray() can
    'still be 1‑based (but the default is 0‑based (faster)).
    '
    If LBound(MicrophoneArray()) = 1 Then
        Dim InputArray() As Integer 'maybe faster than just ReDim
        ReDim InputArray(0 To (SpectrumArraySize ‑ 1&)) As Integer
        Call CopyMemory(InputArray(0), MicrophoneArray(1), SpectrumArraySize)
        Call GFFA_GetSpectrumArray(InputArray(), SpectrumArray(), SpectrumArraySize, GFFA_FILTERBIT_NOFILTER) 'GFFA_FILTERBIT_HANNINGFILTER) 'use Hanning Filter
    Else
        Call GFFA_GetSpectrumArray(MicrophoneArray(), SpectrumArray(), SpectrumArraySize, GFFA_FILTERBIT_NOFILTER) 'GFFA_FILTERBIT_HANNINGFILTER) 'use Hanning Filter
    End If
End Sub

Public Function GFFA_SpectrumArrayIndexToFrequency(ByVal SpectrumArraySize As LongByVal SpectrumArrayIndex As Long, Optional ByVal SAMPLERATE As Long = 44100) As Long
    'on error resume next
    GFFA_SpectrumArrayIndexToFrequency = CLng(CSng(SAMPLERATE) * SpectrumArrayIndex / CSng(SpectrumArraySize))
End Function

Public Function GFFA_FrequencyToSpectrumArrayIndex(ByVal SpectrumArraySize As LongByVal Frequency As Long, Optional ByVal SAMPLERATE As Long = 44100) As Long
    'on error resume next
    GFFA_FrequencyToSpectrumArrayIndex = CLng((CSng(Frequency) * CSng(SpectrumArraySize)) / CSng(SAMPLERATE))
End Function

'***END OF INTERFACE SUBS***
'***OTHER***

Private Function GFFA_ReverseBits(ByVal Number As LongByVal ReversedBitNumber As Integer) As Long
    'on error resume next
    Dim TempInt As Integer
    Dim Temp As Long
    'begin
    For TempInt = 0 To (ReversedBitNumber ‑ 1)
        Temp = (Temp * 2&) Or (Number And 1&)
        Number = Number \ 2&
    Next
    GFFA_ReverseBits = Temp
End Function

Private Function MIN(ByVal Value1 As LongByVal Value2 As Long) As Long
    'on error resume next
    If Value1 < Value2 Then
        MIN = Value1
    Else
        MIN = Value2
    End If
End Function

Private Function MAX(ByVal Value1 As LongByVal Value2 As Long) As Long
    'on error resume next
    If Value1 > Value2 Then
        MAX = Value1
    Else
        MAX = Value2
    End If
End Function

'***END OF OTHER***
'***DUMPED CODE***

'Public Function DEBUG_Test()
'    'on error resume next 'speed test
'    Dim a As Double
'    Dim b As Double
'    Dim c As Double
'    Dim d As Single
'    Dim e As Single
'    Dim f As Single
'    Dim l As Long
'    Dim X As Long
'    Dim y As Long
'    Dim s As Single
'    'begin
''    s = Timer
''    For l = 1 To 100000000
''        a = b + c 'Double
''    Next l
''    Debug.Print Timer ‑ s '14,77344 seconds on an Athlon 800 (@ 850 MHz)
''    s = Timer
''    For l = 1 To 100000000
''        d = e + f 'Single
''    Next l
''    Debug.Print Timer ‑ s '14,99219 seconds on an Athlon 800 (@ 850 MHz)
'    'NOTE: use Double, even faster than Single.
''    s = Timer
''    For l = 1 To 10000000
''        If x >= y Then
''        End If
''    Next l
''    Debug.Print Timer ‑ s
''    s = Timer
''    For l = 1 To 10000000
''        If Not (x < y) Then
''        End If
''    Next l
''    Debug.Print Timer ‑ s
'    'NOTE: both seems to be exactly the same on a lower level (exactly the same time required).
'    Dim SinArray(1 To 62831) As Double 'Static would make it by around 10 percent faster
'    For l = 1 To 62831
'        SinArray(l) = Sin(CDbl(l) / 10000#)
'    Next l
''    s = Timer
''    For l = 1 To 100000000
''        a = Sin(TWO_PI)
''    Next l
''    MsgBox Timer ‑ s
''    s = Timer
''    For l = 1 To 100000000
''        a = SinArray(CLng(TWO_PI * 10000#))
''    Next l
''    MsgBox Timer ‑ s
'    'NOTE: kick VB into the trashcan, much too slow.
'    s = Timer
'    For l = 1 To 10000000
'        Call GFFADLL_Test(SinArray(1))
'    Next l
'    Debug.Print Timer ‑ s
'    'NOTE: ~2.15 seconds with array, ~2.10 seconds with C sin function.
'End Function

'***END OF DUMPED CODE***


[END OF FILE]