Not much left...
FFT with windowing:
Usage: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
Will apply an Hanning window on intSamplesInput and return theCode:InitPower2 ' needs to be called only once FastFourierTransform 1024, intSamplesInput, sngSamplesOutput, WINDOW_FUNC_HANNING
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:
Usage: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
Will boost the volume by 6 dB.Code:ChangeVolume intSamples, UBound(intSamples), 6, VOL_DECIBEL
Echo:
Usage: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
Will add an echo to the signal wich is 500 ms long and will be multiplied by 0.4 after each reverb.Code:DSPEchoSettings 44100, 500, 0.4 DSPEcho intSamples, UBound(intSamples)
Decibel Full Scale:
Will return a value from -96 to 0 dBFS.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
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