Not much left...
FFT with windowing:
Code:
Option Explicit
Private Const Pi As Single = 3.14159265358979
Private Const AngleNum As Single = 2 * Pi
Private lngPow2(31) As Long
Public Enum FFT_WINDOW
WINDOW_FUNC_NONE
WINDOW_FUNC_HANNING
WINDOW_FUNC_HAMMING
WINDOW_FUNC_BLACKMAN
End Enum
' http://www.fullspectrum.com/deeth/main.html
Public Sub FastFourierTransform( _
NumSamples As Long, _
RealIn() As Integer, _
RealOut() As Single, _
Optional wnd As FFT_WINDOW = WINDOW_FUNC_NONE _
)
Dim NumBits As Long
Dim Rev As Long
Dim index As Long
Dim i As Long, j As Long
Dim k As Long, n As Long
Dim BlockSize As Long, BlockEnd As Long
Dim DeltaAngle As Single, DeltaAr As Single
Dim Alpha As Single, Beta As Single
Dim TR As Single, TI As Single
Dim AR As Single, AI As Single
Dim dblWnd() As Single
Dim imagout() As Single
ReDim imagout(NumSamples - 1) As Single
dblWnd = CreateWindow(wnd, NumSamples)
For i = 0 To 16
If (NumSamples And lngPow2(i)) <> 0 Then
NumBits = i
Exit For
End If
Next
For i = 0 To (NumSamples - 1)
index = i
Rev = 0
For k = 0 To NumBits - 1
Rev = (Rev * 2) Or (index And 1)
index = index \ 2
Next
j = Rev
RealOut(j) = RealIn(i) * dblWnd(i)
Next
BlockEnd = 1
BlockSize = 2
Do While BlockSize <= NumSamples
DeltaAngle = AngleNum / BlockSize
Alpha = Sin(0.5 * DeltaAngle)
Alpha = 2# * Alpha * Alpha
Beta = Sin(DeltaAngle)
For i = 0 To NumSamples - 1 Step BlockSize
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
Next
BlockEnd = BlockSize
BlockSize = BlockSize * 2&
Loop
End Sub
Public Sub InitPower2()
Dim i As Long
For i = 0 To 30
lngPow2(i) = 2 ^ i
Next
lngPow2(31) = &H80000000
End Sub
Public Function CreateWindow( _
wnd As FFT_WINDOW, _
ByVal Length As Long _
) As Single()
Dim dblOut() As Single
Dim i As Long
ReDim dblOut(Length - 1) As Single
Select Case wnd
Case WINDOW_FUNC_NONE
For i = 0 To Length - 1
dblOut(i) = 1
Next
Case WINDOW_FUNC_HANNING
For i = 0 To Length - 1
dblOut(i) = 0.5 * (1 - Cos(i * 2 * Pi / (Length - 1)))
Next
Case WINDOW_FUNC_HAMMING
For i = 0 To Length - 1
dblOut(i) = 0.54 - (0.46 * Cos((i) * 2 * Pi / (Length - 1)))
Next
Case WINDOW_FUNC_BLACKMAN
For i = 0 To Length - 1
dblOut(i) = 0.42 - (0.5 * Cos((i) * 2 * Pi / (Length - 1))) + (0.08 * Cos((i) * 4 * Pi / (Length - 1)))
Next
End Select
CreateWindow = dblOut
End Function
Usage:
Code:
InitPower2 ' needs to be called only once
FastFourierTransform 1024, intSamplesInput, sngSamplesOutput, WINDOW_FUNC_HANNING
Will apply an Hanning window on intSamplesInput and return the
frequency domain in sngSamplesOutput (NumSamples has to be 2^N),
where each element in the array represents samplerate / NumSamples bandwidth, if I remember correctly.
Changing volume:
Code:
Public Enum VOL_UNIT
VOL_DECIBEL
VOL_PERCENT
VOL_FACTOR
End Enum
Public Sub ChangeVolume( _
intSamples() As Integer, _
ByVal datalen As Long, _
ByVal value As Single, _
ByVal unit As VOL_UNIT _
)
Dim sngFactor As Single
Dim sngResult As Single
Dim i As Long
Select Case unit
Case VOL_DECIBEL
sngFactor = 10 ^ (value / 20)
Case VOL_PERCENT
sngFactor = value / 100
Case VOL_FACTOR
sngFactor = value
End Select
For i = 0& To datalen
sngResult = intSamples(i) * sngFactor
If sngResult > 32767# Then
intSamples(i) = 32767
ElseIf sngResult < -32768# Then
intSamples(i) = -32768
Else
intSamples(i) = CInt(sngResult)
End If
Next
End Sub
Usage:
Code:
ChangeVolume intSamples, UBound(intSamples), 6, VOL_DECIBEL
Will boost the volume by 6 dB.
Echo:
Code:
Private intEcho() As Integer
Private lngEchoPos As Long
Private lngEchoLength As Single
Public Sub DSPEcho( _
intSamples() As Integer, _
ByVal datalength As Long _
)
Dim i As Long
For i = 0 To datalength
intSamples(i) = norm(CLng(intSamples(i)) + intEcho(lngEchoPos))
intEcho(lngEchoPos) = intSamples(i) * lngEchoLength
lngEchoPos = lngEchoPos + 1
If lngEchoPos > UBound(intEcho) Then
lngEchoPos = 0
End If
Next
End Sub
Public Sub DSPEchoSettings( _
ByVal samplerate As Long, _
ByVal echo_length_ms As Long, _
ByVal echo_length As Single _
)
Dim lngEchoPoints As Long
lngEchoPoints = samplerate / 1000 * echo_length_ms
ReDim intEcho(lngEchoPoints - 1) As Integer
lngEchoLength = echo_length
lngEchoPos = 0
End Sub
Usage:
Code:
DSPEchoSettings 44100, 500, 0.4
DSPEcho intSamples, UBound(intSamples)
Will add an echo to the signal wich is 500 ms long and will be multiplied by 0.4 after each reverb.
Decibel Full Scale:
Code:
Public Function dBFS(ByVal amplitude As Long) As Double
If amplitude = 0 Then
dBFS = -96
Else
dBFS = 20 * ((Log(Abs(amplitude) / 32768)) / Log(10))
End If
End Function
Will return a value from -96 to 0 dBFS.
I also have written encoders and decoders for wav/mp3/ape/ogg/wma/cda (for a streaming player), but with german comments, if you're interested.
I just don't have the time to translate it all, else I would've already posted it at PSC.
Reply With Quote
Originally Posted by CVMichael
, but the Nyquist frequency (the highest possible freq) would
Mark Thread Resolved
How to adjust mic input level?
Hi CVMichael, 
Re: Sugestions or Comments about my Sound Tutorial
