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 Any, ByRef SpectrumArray As Any, ByVal SpectrumArraySize As Long, ByRef ReversedBitArray As Any, ByVal FilterBits As Long)
'GFFA_MicrophoneArrayToSpectrumArray
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal 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 Integer, ByRef SpectrumArray() As Double, ByVal SpectrumArraySize As Long, ByVal 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 Integer, ByRef SpectrumArray() As Double, ByVal SpectrumArraySize As Long, ByRef 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 Double, ByVal 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 Double, ByVal 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 Integer, ByRef SpectrumArray() As Double, ByVal 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 Long, ByVal 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 Long, ByVal 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 Long, ByVal 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 Long, ByVal 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 Long, ByVal 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]