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