Here is version with frequency visualisation, including recalculation of visualization depending on how the ear perceives different frequencies.
Code: (Select All)
_Title "QB64PE Sound Equalizer"
Zdroj = _SndOpen("b.mp3") 'USE MP3 here (MEM read singles from _Memsound block)
Dim Zvuk As _MEM
Dim A As Long
UU = 2047 ' We detecting frequency from 8192 samples (0 to 8191)
Dim Blok(UU) As Single ' Block for FFT samples - Left channel
Dim BlokR(UU) As Single ' Right
Dim RealPart(UU) As Single, ImagPart(UU) As Single ' Real and imaginary signal values for FFT - Left
Dim RealPartR(UU) As Single, ImagPartR(UU) As Single ' - Right
Dim Eq(9) As Single
Dim Shared N As Long
Dim VzorkovaciFrekvence As Single ' SoundRate
Dim VisualEq(9) As Single
Dim Colors(9) As _Unsigned Long
Colors(0) = _RGB32(255, 0, 0)
Colors(1) = _RGB32(255, 127, 0)
Colors(2) = _RGB32(255, 255, 0)
Colors(3) = _RGB32(127, 255, 0)
Colors(4) = _RGB32(0, 255, 0)
Colors(5) = _RGB32(0, 255, 127)
Colors(6) = _RGB32(0, 255, 255)
Colors(7) = _RGB32(0, 127, 255)
Colors(8) = _RGB32(0, 0, 255)
Colors(9) = _RGB32(127, 0, 255)
' Scales for correcting the sensitivity of the human ear (Fletcher-Munson)
Dim Korekce(9) As Single
Korekce(0) = 2.0 ' We amplify bass frequencies (2 to 64 Hz)
Korekce(1) = 1.8 ' We will amplify low bass (65 to 125 Hz)
Korekce(2) = 1.5 ' Middle bass (126 to 250 Hz)
Korekce(3) = 1.2 ' Lower midrange (251 to 500 Hz)
Korekce(4) = 1.0 ' Mindrange (501 to 1000 Hz)
Korekce(5) = 0.8 ' Higher Mindrange (1001 to 2000 Hz)
Korekce(6) = 0.7 ' Lower treble (2001 to 4000 Hz)
Korekce(7) = 0.6 ' Treble (4001 to 8000 Hz)
Korekce(8) = 0.5 ' Higher treble (8001 to 16000 Hz)
Korekce(9) = 0.4 ' Ultrasonic frequencies (16001 to 22000 Hz) are suppressed
N = UU + 1 ' FFT Block size
Zvuk = _MemSound(Zdroj, 0)
VzorkovaciFrekvence = _SndRate
Screen _NewImage(800, 600, 32) ' Create a new window for visualization
For FillEq = 0 To 9
Eq(FillEq) = 2
Next
Do Until A& = Zvuk.SIZE
' Naètení bloku vzorkù
For i = 0 To N - 1
If A& >= Zvuk.SIZE Then Exit For
LevaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A&, Single)
PravaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A& + 4, Single)
Blok(i) = LevaStopa ' Left Track
BlokR(i) = PravaStopa ' Right Track
RealPart(i) = LevaStopa ' Left Track AudioData RealPart must contains sound data
RealPartR(i) = PravaStopa ' Right Track AudioData
ImagPart(i) = 0 ' Left Track imaginary data
ImagPartR(i) = 0 ' Right Track imaginary data
A& = A& + 8 ' go to next sample (8 bytes = 2 * 4 (left, right))
Next i
' Apply FFT to block
Call FFT(RealPart(), ImagPart(), N) ' shift sound from time run to frequency run - Left Track
Call FFT(RealPartR(), ImagPartR(), N) ' the same - Right Track
'spectrum filtration
For k = 0 To N - 1
Frekvence = k * VzorkovaciFrekvence / N 'Frequency calculation (k * _SndRate / N)
Vol = 0
Select Case Frekvence 'use frequency for equalizing!
Case 2 To 64: Vol = Eq(0): VisualEq(0) = VisualEq(0) + Abs(RealPart(k)) * Eq(0) * Korekce(0)
Case 65 To 125: Vol = Eq(1): VisualEq(1) = VisualEq(1) + Abs(RealPart(k)) * Eq(1) * Korekce(1)
Case 126 To 250: Vol = Eq(2): VisualEq(2) = VisualEq(2) + Abs(RealPart(k)) * Eq(2) * Korekce(2)
Case 251 To 500: Vol = Eq(3): VisualEq(3) = VisualEq(3) + Abs(RealPart(k)) * Eq(3) * Korekce(3)
Case 501 To 1000: Vol = Eq(4): VisualEq(4) = VisualEq(4) + Abs(RealPart(k)) * Eq(4) * Korekce(4)
Case 1001 To 2000: Vol = Eq(5): VisualEq(5) = VisualEq(5) + Abs(RealPart(k)) * Eq(5) * Korekce(5)
Case 2001 To 4000: Vol = Eq(6): VisualEq(6) = VisualEq(6) + Abs(RealPart(k)) * Eq(6) * Korekce(6)
Case 4001 To 8000: Vol = Eq(7): VisualEq(7) = VisualEq(7) + Abs(RealPart(k)) * Eq(7) * Korekce(7)
Case 8001 To 16000: Vol = Eq(8): VisualEq(8) = VisualEq(8) + Abs(RealPart(k)) * Eq(8) * Korekce(8)
Case 16001 To 22000: Vol = Eq(9): VisualEq(9) = VisualEq(9) + Abs(RealPart(k)) * Eq(9) * Korekce(9)
End Select
RealPart(k) = RealPart(k) * Vol 'update frequency so, as is equalization set
ImagPart(k) = ImagPart(k) * Vol
RealPartR(k) = RealPartR(k) * Vol
ImagPartR(k) = ImagPartR(k) * Vol
Next k
'create new audio signal using IFFT (from this block)
Call IFFT(RealPart(), ImagPart(), N)
Call IFFT(RealPartR(), ImagPartR(), N)
'Play created signal
For i = 0 To N - 1
If RealPart(i) > .95 Then RealPart(i) = .95
If RealPart(i) < -.95 Then RealPart(i) = -.95
If RealPartR(i) > .95 Then RealPartR(i) = .95
If RealPartR(i) < -.95 Then RealPartR(i) = -.95
_SndRaw RealPart(i), RealPartR(i)
Next i
Cls
For EqBand = 0 To 9
VisualEq(EqBand) = VisualEq(EqBand) / N ' Normalize
BarHeight = VisualEq(EqBand) * 400 ' Scale to fit screen
Line (EqBand * 80 + 20, 600)-(EqBand * 80 + 60, 600 - BarHeight), Colors(EqBand), BF
Next
Do Until _SndRawLen < .05 'wait until is possible playing next block and it this time use keyboard
i$ = InKey$
Select Case LCase$(i$)
Case "q": Eq(0) = Eq(0) + .1
Case "a": Eq(0) = Eq(0) - .1
Case "w": Eq(1) = Eq(1) + .1
Case "s": Eq(1) = Eq(1) - .1
Case "e": Eq(2) = Eq(2) + .1
Case "d": Eq(2) = Eq(2) - .1
Case "r": Eq(3) = Eq(3) + .1
Case "f": Eq(3) = Eq(3) - .1
Case "t": Eq(4) = Eq(4) + .1
Case "g": Eq(4) = Eq(4) - .1
Case "y": Eq(5) = Eq(5) + .1
Case "h": Eq(5) = Eq(5) - .1
Case "u": Eq(6) = Eq(6) + .1
Case "j": Eq(6) = Eq(6) - .1
Case "i": Eq(7) = Eq(7) + .1
Case "k": Eq(7) = Eq(7) - .1
Case "o": Eq(8) = Eq(8) + .1
Case "l": Eq(8) = Eq(8) - .1
Case "p": Eq(9) = Eq(9) + .1
Case ";": Eq(9) = Eq(9) - .1
End Select
Locate 4
Print " Use keys for equalize:"
Print
Print " q/a [2 to 64 Hz] "; Int((Eq(0) - 2) * 100); "% "
Print " w/s [65 to 125 Hz] "; Int((Eq(1) - 2) * 100); "% "
Print " e/d [126 to 250 Hz] "; Int((Eq(2) - 2) * 100); "% "
Print " r/f [251 to 500 Hz] "; Int((Eq(3) - 2) * 100); "% "
Print " t/g [501 to 1000 Hz] "; Int((Eq(4) - 2) * 100); "% "
Print " y/h [1001 to 2000 Hz] "; Int((Eq(5) - 2) * 100); "% "
Print " u/j [2001 to 4000 Hz] "; Int((Eq(6) - 2) * 100); "% "
Print " i/k [4001 to 8000 Hz] "; Int((Eq(7) - 2) * 100); "% "
Print " o/l [8001 to 16000 Hz] "; Int((Eq(8) - 2) * 100); "% "
Print " p/; [16001 to 22000 Hz] "; Int((Eq(9) - 2) * 100); "% "
_Display
For EqVolsTest = 0 To 9
If Eq(EqVolsTest) > 4 Then Eq(EqVolsTest) = 4
If Eq(EqVolsTest) < 0 Then Eq(EqVolsTest) = 0
Next
Loop
'_Display
Loop
_MemFree Zvuk
End
Sub FFT (RealPart() As Single, ImagPart() As Single, N As Long)
Dim i As Long, j As Long, k As Long, m As Long, stp As Long
Dim angle As Double
Dim tReal As Double, tImag As Double, uReal As Double, uImag As Double
' Bit-reverse permutation (That sounds really good, doesn't it?) Don't ask me what that means, okay? ))
j = 0
For i = 0 To N - 1
If i < j Then
Swap RealPart(i), RealPart(j)
Swap ImagPart(i), ImagPart(j)
End If
k = N \ 2
Do While (k >= 1 And j >= k)
j = j - k
k = k \ 2
Loop
j = j + k
Next i
m = 1
Do While m < N
stp = m * 2
angle = -3.14159265359 / m
For k = 0 To m - 1
uReal = Cos(k * angle)
uImag = Sin(k * angle)
For i = k To N - 1 Step stp
j = i + m
tReal = uReal * RealPart(j) - uImag * ImagPart(j)
tImag = uReal * ImagPart(j) + uImag * RealPart(j)
RealPart(j) = RealPart(i) - tReal
ImagPart(j) = ImagPart(i) - tImag
RealPart(i) = RealPart(i) + tReal
ImagPart(i) = ImagPart(i) + tImag
Next i
Next k
m = stp
Loop
End Sub
Sub IFFT (RealPart() As Single, ImagPart() As Single, N As Long)
Dim i As Long
' Reversing the signs of imaginary components
For i = 0 To N - 1
ImagPart(i) = -ImagPart(i)
Next i
' Performing FFT
Call FFT(RealPart(), ImagPart(), N)
'Normalization and re-rotation of the signs of the imaginary components
For i = 0 To N - 1
RealPart(i) = RealPart(i) / N
ImagPart(i) = -ImagPart(i) / N
Next i
End Sub