Posts: 353
Threads: 54
Joined: May 2022
Reputation:
52
01-12-2025, 07:43 PM
(This post was last modified: 01-12-2025, 08:18 PM by Petr.)
Don't be afraid to report bugs! Didn't you notice that one speaker is silent after my answer for a740g? The bug has been found and fixed. There was a typo (just before the commented end of the answer) here: NewRealPartR(i) = RealPartRInterpolatedR
NewImagPartR(i) = ImagPartRInterpolatedR
Do you see that one extra R there? That's a cheeky letter R! Very bad cheeky!  Fixed to
NewRealPartR(i) = RealPartInterpolatedR
NewImagPartR(i) = ImagPartInterpolatedR
and now playing in stereo.
Do you want a rough bass? The volume is monitored by this loop:
For EqVolsTest = 0 To 9
If Eq(EqVolsTest) > 4 Then Eq(EqVolsTest) = 4 '4 is optimal value
If Eq(EqVolsTest) < 0 Then Eq(EqVolsTest) = 0
Next
You have a value other than 4. But don't come to me with bills for new speakers.
I'm working on removing the cracking.
Posts: 353
Threads: 54
Joined: May 2022
Reputation:
52
Well, I did what I could. If you overdo a certain frequency, the crackling will still be heard. When used outside the extreme limits, I think it's a little better. I added two effects to it. Key 3 turns the ping pong effect on/off, and keys 4, 5, 6, 7 set its parameters. 4 and 5 for Delay Time and 6 and 7 for FeddBack. The second effect is inactive until you turn it up, then turn it down to deactivate it (keys 1 and 2). Oh, and it plays in stereo. Work is still ongoing.
Code: (Select All)
| | | | | _Title "QB64PE Sound Equalizer v. 2" | | Zdroj = _SndOpen("b.mp3") | | Dim Zvuk As _MEM | | Dim A As Long | | UU = 4095 | | Dim Blok(UU) As Single | | Dim BlokR(UU) As Single | | Dim RealPart(UU) As Single, ImagPart(UU) As Single | | Dim RealPartR(UU) As Single, ImagPartR(UU) As Single | | Dim Eq(9) As Single | | | | ReDim NewRealPartR(UU) As Single | | ReDim NewImagPartR(UU) As Single | | ReDim NewRealPart(UU) As Single | | ReDim NewImagPart(UU) As Single | | | | ReDim Shared delayBufferL(0) As Single, delayBufferR(0) As Single | | Dim Shared N As Long | | Dim VzorkovaciFrekvence As Single | | 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) | | | | | | Dim Korekce(9) As Single | | Korekce(0) = 2.0 | | Korekce(1) = 1.8 | | Korekce(2) = 1.5 | | Korekce(3) = 1.2 | | Korekce(4) = 1.0 | | Korekce(5) = 0.8 | | Korekce(6) = 0.7 | | Korekce(7) = 0.6 | | Korekce(8) = 0.5 | | Korekce(9) = 0.4 | | | | | | N = UU + 1 | | Fk = 1 | | | | | | Zvuk = _MemSound(Zdroj, 0) | | VzorkovaciFrekvence = _SndRate | | Screen _NewImage(800, 600, 32) | | | | For FillEq = 0 To 9 | | Eq(FillEq) = 2 | | Next | | | | Do Until A& = Zvuk.SIZE | | | | 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 | | BlokR(i) = PravaStopa | | RealPart(i) = LevaStopa | | RealPartR(i) = PravaStopa | | ImagPart(i) = 0 | | ImagPartR(i) = 0 | | A& = A& + 8 | | Next i | | | | | | | | | | | | | | | | Call FFT(RealPart(), ImagPart(), N) | | Call FFT(RealPartR(), ImagPartR(), N) | | | | | | | | For k = 0 To N - 1 | | Frekvence = k * VzorkovaciFrekvence / N | | Vol = 0 | | Select Case Frekvence | | Case 10 To 64: Vol = Eq(0): VisualEq(0) = VisualEq(0) + Abs(RealPart(k)) * Eq(0) * Korekce(0) | | Case 60 To 120: Vol = Eq(1): VisualEq(1) = VisualEq(1) + Abs(RealPart(k)) * Eq(1) * Korekce(1) | | Case 110 To 250: Vol = Eq(2): VisualEq(2) = VisualEq(2) + Abs(RealPart(k)) * Eq(2) * Korekce(2) | | Case 230 To 500: Vol = Eq(3): VisualEq(3) = VisualEq(3) + Abs(RealPart(k)) * Eq(3) * Korekce(3) | | Case 480 To 1000: Vol = Eq(4): VisualEq(4) = VisualEq(4) + Abs(RealPart(k)) * Eq(4) * Korekce(4) | | Case 900 To 2000: Vol = Eq(5): VisualEq(5) = VisualEq(5) + Abs(RealPart(k)) * Eq(5) * Korekce(5) | | Case 1900 To 4000: Vol = Eq(6): VisualEq(6) = VisualEq(6) + Abs(RealPart(k)) * Eq(6) * Korekce(6) | | Case 3700 To 8000: Vol = Eq(7): VisualEq(7) = VisualEq(7) + Abs(RealPart(k)) * Eq(7) * Korekce(7) | | Case 7000 To 16000: Vol = Eq(8): VisualEq(8) = VisualEq(8) + Abs(RealPart(k)) * Eq(8) * Korekce(8) | | Case 14000 To 22000: Vol = Eq(9): VisualEq(9) = VisualEq(9) + Abs(RealPart(k)) * Eq(9) * Korekce(9) | | End Select | | | | RealPart(k) = RealPart(k) * Vol | | ImagPart(k) = ImagPart(k) * Vol | | | | RealPartR(k) = RealPartR(k) * Vol | | ImagPartR(k) = ImagPartR(k) * Vol | | Next k | | | | | | | | | | | | | | For i = 0 To N - 1 | | | | | | newIndex = i * Fk | | | | | | If newIndex > N - 1 Then | | newIndex = N - 1 | | End If | | | | | | index1 = Int(newIndex) | | index2 = index1 + 1 | | | | | | If index2 > N - 1 Then | | index2 = index1 | | End If | | | | | | weight = newIndex - index1 | | | | | | RealPartInterpolated = RealPart(index1) + weight * (RealPart(index2) - RealPart(index1)) | | ImagPartInterpolated = ImagPart(index1) + weight * (ImagPart(index2) - ImagPart(index1)) | | | | | | RealPartInterpolatedR = RealPartR(index1) + weight * (RealPartR(index2) - RealPartR(index1)) | | ImagPartInterpolatedR = ImagPartR(index1) + weight * (ImagPartR(index2) - ImagPartR(index1)) | | | | | | | | NewRealPart(i) = RealPartInterpolated | | NewImagPart(i) = ImagPartInterpolated | | NewRealPartR(i) = RealPartInterpolatedR | | NewImagPartR(i) = ImagPartInterpolatedR | | | | Next i | | | | | | | | | | Call IFFT(NewRealPart(), NewImagPart(), N) | | Call IFFT(NewRealPartR(), NewImagPartR(), N) | | | | StereoAutoPanner NewRealPart(), NewRealPartR(), sp, _SndRate | | | | If pong Then | | PingPongDelay NewRealPart(), NewRealPartR(), delaytime, feedback, _SndRate | | End If | | | | | | LowPassFilterInPlace NewRealPart(), 14000, _SndRate | | LowPassFilterInPlace NewRealPartR(), 14000, _SndRate | | | | NormalizeSignal NewRealPart() | | NormalizeSignal NewRealPartR() | | | | | | | | For i = 0 To N - 1 | | _SndRaw NewRealPart(i), NewRealPartR(i) | | Next i | | | | Cls | | For EqBand = 0 To 9 | | VisualEq(EqBand) = VisualEq(EqBand) / N | | BarHeight = VisualEq(EqBand) * 80 | | Line (EqBand * 80 + 20, 600)-(EqBand * 80 + 60, 600 - BarHeight), Colors(EqBand), BF | | Next | | | | | | Do Until _SndRawLen < .05 | | 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 | | Case "+": Fk = Fk + .01 | | Case "-": Fk = Fk - .01 | | Case "*": Fk = 1 | | Case "1": sp = sp + 0.01 | | Case "2": sp = sp - 0.01 | | Case "3": pong = Not pong: _Delay .01 | | Case "4": delaytime = delaytime + .01 | | Case "5": delaytime = delaytime - .01 | | Case "6": feedback = feedback + .01 | | Case "7": feedback = feedback - .01 | | | | End Select | | If Fk < .1 Then Fk = .1 | | If Fk > 1.9 Then Fk = 1.9 | | | | | | Locate 4 | | Print " Use keys for equalize:" | | Print | | Print " q/a [2 to 64 Hz] "; Int(Eq(0) / 8 * 100); "% " | | Print " w/s [65 to 125 Hz] "; Int(Eq(1) / 8 * 100); "% " | | Print " e/d [126 to 250 Hz] "; Int(Eq(2) / 8 * 100); "% " | | Print " r/f [251 to 500 Hz] "; Int(Eq(3) / 8 * 100); "% " | | Print " t/g [501 to 1000 Hz] "; Int(Eq(4) / 8 * 100); "% " | | Print " y/h [1001 to 2000 Hz] "; Int(Eq(5) / 8 * 100); "% " | | Print " u/j [2001 to 4000 Hz] "; Int(Eq(6) / 8 * 100); "% " | | Print " i/k [4001 to 8000 Hz] "; Int(Eq(7) / 8 * 100); "% " | | Print " o/l [8001 to 16000 Hz] "; Int(Eq(8) / 8 * 100); "% " | | Print " p/; [16001 to 22000 Hz] "; Int(Eq(9) / 8 * 100); "% " | | Print " + or - for changing frequency shift, * for reset back " | | Print " 1, 2 for Stereo panner"; Int(sp * 100) / 100 | | Print "3, 4, 5, 6, 7 for Ping-Pong effect "; pong; Int(delaytime * 100) / 100; Int(feedback * 100) / 100 | | | | _Display | | | | For EqVolsTest = 0 To 9 | | If Eq(EqVolsTest) > 8 Then Eq(EqVolsTest) = 8 | | If Eq(EqVolsTest) < 0 Then Eq(EqVolsTest) = 0 | | Next | | Loop | | | | Loop | | _MemFree Zvuk | | End | | | | Sub FFT (iRealPart() As Single, iImagPart() 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 | | | | | | j = 0 | | For i = 0 To N - 1 | | If i < j Then | | Swap iRealPart(i), iRealPart(j) | | Swap iImagPart(i), iImagPart(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 * iRealPart(j) - uImag * iImagPart(j) | | tImag = uReal * iImagPart(j) + uImag * iRealPart(j) | | iRealPart(j) = iRealPart(i) - tReal | | iImagPart(j) = iImagPart(i) - tImag | | iRealPart(i) = iRealPart(i) + tReal | | iImagPart(i) = iImagPart(i) + tImag | | Next i | | Next k | | m = stp | | Loop | | End Sub | | | | Sub IFFT (iRealPart() As Single, iImagPart() As Single, N As Long) | | Dim i As Long | | | | | | For i = 0 To N - 1 | | iImagPart(i) = -iImagPart(i) | | Next i | | | | | | Call FFT(iRealPart(), iImagPart(), N) | | | | | | For i = 0 To N - 1 | | iRealPart(i) = iRealPart(i) / N | | iImagPart(i) = -iImagPart(i) / N | | Next i | | End Sub | | | | | | | | Sub NormalizeSignal (arr() As Single) | | Dim maxVal As Single | | Dim i As Long | | | | maxVal = 0 | | For i = LBound(arr) To UBound(arr) | | If Abs(arr(i)) > maxVal Then maxVal = Abs(arr(i)) | | Next | | | | | | If maxVal > 1 Then | | For i = LBound(arr) To UBound(arr) | | arr(i) = arr(i) / maxVal | | Next | | End If | | End Sub | | | | Sub LowPassFilterInPlace (signalArray() As Single, cutoffFreq As Single, sampleRate As Single) | | Dim alpha As Single | | Dim prevOutput As Single | | | | alpha = 1.0 / (1.0 + (sampleRate / (2 * _Pi * cutoffFreq))) | | | | prevOutput = signalArray(0) | | For i = 1 To UBound(signalArray) | | signalArray(i) = alpha * signalArray(i) + (1 - alpha) * prevOutput | | prevOutput = signalArray(i) | | Next | | End Sub | | | | Sub StereoAutoPanner (leftArray() As Single, rightArray() As Single, panSpeed As Single, sampleRate As Single) | | Static t As Single | | | | For i = 0 To UBound(leftArray) | | Dim pan As Single | | pan = 0.5 * (1 + Sin(t * 2 * _Pi * panSpeed / sampleRate)) | | | | | | Dim original As Single | | original = (leftArray(i) + rightArray(i)) * 0.5 | | leftArray(i) = original * (1 - pan) | | rightArray(i) = original * pan | | | | t = t + 1 | | Next | | | | | | If t > sampleRate / panSpeed Then t = 0 | | End Sub | | | | Sub PingPongDelay (leftArray() As Single, rightArray() As Single, delayTime As Single, feedback As Single, sampleRate As Single) | | Static delayIndex As Long | | | | | | If delayTime <= 0 Or feedback <= 0 Or sampleRate <= 0 Then | | Exit Sub | | End If | | | | | | Dim delaySamples As Long | | delaySamples = Int(delayTime * sampleRate) | | | | | | If UBound(delayBufferL) < delaySamples Then | | ReDim _Preserve delayBufferL(0 To delaySamples) | | ReDim _Preserve delayBufferR(0 To delaySamples) | | End If | | | | | | For i = 0 To UBound(leftArray) | | Dim dryL As Single, dryR As Single | | Dim wetL As Single, wetR As Single | | | | | | dryL = leftArray(i) | | dryR = rightArray(i) | | | | | | wetL = delayBufferL(delayIndex) | | wetR = delayBufferR(delayIndex) | | | | | | leftArray(i) = dryL + wetR * 0.5 | | rightArray(i) = dryR + wetL * 0.5 | | | | | | delayBufferL(delayIndex) = dryL + wetR * feedback | | delayBufferR(delayIndex) = dryR + wetL * feedback | | | | | | delayIndex = (delayIndex + 1) Mod delaySamples | | Next | | End Sub |
Posts: 353
Threads: 54
Joined: May 2022
Reputation:
52
Among other things, I worked on removing the clicks. I succeeded. Three times and each time differently. Source codes as they are: First version - uses Hanning window. But there is audible sound floating, which is of course an undesirable effect, but I'm putting it here anyway. It's simply the first development branch. In the source code, find: factor = 0.85 - 0.15 * Cos(2 * 3.14159265359 * i / (N - 1)) and here, by adjusting the ratio (rewriting the numbers 0.85 and 0.15), adjust the strength of the Hanning window. Too small a window means less sound floating and more audible pops, if they occur, but on the other hand, with the opposite ratio, the sound will float without pops. Here it's a difficult compromise. So I continued on, to the second source code: It's the same thing, but with the addition of smooth frequency filtering:
In the transition zones between bands (e.g. between 64 and 65 Hz, 125 and 126 Hz, etc.), a linear interpolation is used to calculate the gain, which makes the sudden changes that caused the clicks appear. Then there's RMS normalization with exponential smoothing:
After the IFFT, the RMS value of the original (unprocessed) block and the processed block is calculated. The new normalization factor is smoothed using the previous value (smoothing factor set to 0.8) to make the sudden changes in volume appear.
This version has the problem that it can still cause clicks at really extreme values, and above all, that when using only the bass band, the higher frequency band is also heard. Then I found out what was not clear to me (there is much more):
In order to really filter without popping, the Overlap-Add method was added. This solution uses a block transformation with overlap (usually 50% overlap, i.e. for a block of 2048 samples, each block is shifted by 1024 samples). After processing each block, the resulting (inverse FFT) block is added to the synthesis buffer. The first 1024 samples are then sent from this buffer and the rest are shifted to the beginning of the buffer. Next, the second half of the previous block is added to the input block (for further processing) and supplemented with new samples from the sound memory. This solution eliminated the floating sound even with a sharp Hannig window (50 by 50). Then, in the third version, the sound equalization had to be adjusted so that it does not equalize somewhere from 2Hz but from 40 Hz. The reason was that when this band was boosted to maximum and the other bands were turned to minimum, a sound at another higher frequency was also heard (necessary for remove the pops). Since this behavior was undesirable, I set the lowest frequency from 40 Hz and then added a filter that removes higher frequencies when boosting the bass band. All three versions are available here so that everyone can adjust it to their own liking.
Source code 1:
Code: (Select All)
| | | | | | | | | _Title "QB64PE Sound Equalizer with RMS Smoothing" | | | | | | Zdroj = _SndOpen("b.mp3") | | Dim Zvuk As _MEM | | | | Dim A As Long | | UU = 2047 | | Dim Blok(UU) As Single | | Dim BlokR(UU) As Single | | Dim RealPart(UU) As Single, ImagPart(UU) As Single | | Dim RealPartR(UU) As Single, ImagPartR(UU) As Single | | Dim Eq(9) As Single | | | | Dim Shared N As Long | | Dim VzorkovaciFrekvence As Single | | 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) | | | | | | Dim Korekce(9) As Single | | Korekce(0) = 2.0 | | Korekce(1) = 1.8 | | Korekce(2) = 1.5 | | Korekce(3) = 1.2 | | Korekce(4) = 1.0 | | Korekce(5) = 0.8 | | Korekce(6) = 0.7 | | Korekce(7) = 0.6 | | Korekce(8) = 0.5 | | Korekce(9) = 0.4 | | | | N = UU + 1 | | | | Zvuk = _MemSound(Zdroj, 0) | | VzorkovaciFrekvence = _SndRate | | Screen _NewImage(800, 600, 32) | | | | | | For FillEq = 0 To 9 | | Eq(FillEq) = 2 | | Next | | | | | | Dim prevScaleFactor As Single | | prevScaleFactor = 1 | | | | | | | | Do Until A >= Zvuk.SIZE | | | | | | For EqBand = 0 To 9 | | VisualEq(EqBand) = 0 | | Next EqBand | | | | | | For i = 0 To N - 1 | | If A >= Zvuk.SIZE Then Exit For | | Dim LevaStopa As Single, PravaStopa As Single | | LevaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A, Single) | | PravaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A + 4, Single) | | | | Blok(i) = LevaStopa | | BlokR(i) = PravaStopa | | | | RealPart(i) = LevaStopa | | RealPartR(i) = PravaStopa | | ImagPart(i) = 0 | | ImagPartR(i) = 0 | | A = A + 8 | | Next i | | | | | | | | | | For i = 0 To N - 1 | | factor = 0.75 - 0.25 * Cos(2 * 3.14159265359 * i / (N - 1)) | | RealPart(i) = RealPart(i) * factor | | RealPartR(i) = RealPartR(i) * factor | | Next i | | | | | | | | Call FFT(RealPart(), ImagPart(), N) | | Call FFT(RealPartR(), ImagPartR(), N) | | | | | | For k = 0 To N - 1 | | Frekvence = k * VzorkovaciFrekvence / N | | Dim Vol As Single, t As Single | | | | | | If Frekvence < 2 Or Frekvence > 22000 Then | | Vol = 1 | | ElseIf Frekvence < 64 Then | | Vol = Eq(0) * Korekce(0) | | ElseIf Frekvence < 65 Then | | t = (Frekvence - 64) / 1 | | Vol = (1 - t) * (Eq(0) * Korekce(0)) + t * (Eq(1) * Korekce(1)) | | ElseIf Frekvence < 125 Then | | Vol = Eq(1) * Korekce(1) | | ElseIf Frekvence < 126 Then | | t = (Frekvence - 125) / 1 | | Vol = (1 - t) * (Eq(1) * Korekce(1)) + t * (Eq(2) * Korekce(2)) | | ElseIf Frekvence < 250 Then | | Vol = Eq(2) * Korekce(2) | | ElseIf Frekvence < 251 Then | | t = (Frekvence - 250) / 1 | | Vol = (1 - t) * (Eq(2) * Korekce(2)) + t * (Eq(3) * Korekce(3)) | | ElseIf Frekvence < 500 Then | | Vol = Eq(3) * Korekce(3) | | ElseIf Frekvence < 501 Then | | t = (Frekvence - 500) / 1 | | Vol = (1 - t) * (Eq(3) * Korekce(3)) + t * (Eq(4) * Korekce(4)) | | ElseIf Frekvence < 1000 Then | | Vol = Eq(4) * Korekce(4) | | ElseIf Frekvence < 1001 Then | | t = (Frekvence - 1000) / 1 | | Vol = (1 - t) * (Eq(4) * Korekce(4)) + t * (Eq(5) * Korekce(5)) | | ElseIf Frekvence < 2000 Then | | Vol = Eq(5) * Korekce(5) | | ElseIf Frekvence < 2001 Then | | t = (Frekvence - 2000) / 1 | | Vol = (1 - t) * (Eq(5) * Korekce(5)) + t * (Eq(6) * Korekce(6)) | | ElseIf Frekvence < 4000 Then | | Vol = Eq(6) * Korekce(6) | | ElseIf Frekvence < 4001 Then | | t = (Frekvence - 4000) / 1 | | Vol = (1 - t) * (Eq(6) * Korekce(6)) + t * (Eq(7) * Korekce(7)) | | ElseIf Frekvence < 8000 Then | | Vol = Eq(7) * Korekce(7) | | ElseIf Frekvence < 8001 Then | | t = (Frekvence - 8000) / 1 | | Vol = (1 - t) * (Eq(7) * Korekce(7)) + t * (Eq(8) * Korekce(8)) | | ElseIf Frekvence < 16000 Then | | Vol = Eq(8) * Korekce(8) | | ElseIf Frekvence < 16001 Then | | t = (Frekvence - 16000) / 1 | | Vol = (1 - t) * (Eq(8) * Korekce(8)) + t * (Eq(9) * Korekce(9)) | | Else | | Vol = Eq(9) * Korekce(9) | | End If | | | | | | Select Case Frekvence | | Case 2 To 64: VisualEq(0) = VisualEq(0) + Abs(RealPart(k)) * Vol | | Case 65 To 125: VisualEq(1) = VisualEq(1) + Abs(RealPart(k)) * Vol | | Case 126 To 250: VisualEq(2) = VisualEq(2) + Abs(RealPart(k)) * Vol | | Case 251 To 500: VisualEq(3) = VisualEq(3) + Abs(RealPart(k)) * Vol | | Case 501 To 1000: VisualEq(4) = VisualEq(4) + Abs(RealPart(k)) * Vol | | Case 1001 To 2000: VisualEq(5) = VisualEq(5) + Abs(RealPart(k)) * Vol | | Case 2001 To 4000: VisualEq(6) = VisualEq(6) + Abs(RealPart(k)) * Vol | | Case 4001 To 8000: VisualEq(7) = VisualEq(7) + Abs(RealPart(k)) * Vol | | Case 8001 To 16000: VisualEq(8) = VisualEq(8) + Abs(RealPart(k)) * Vol | | Case 16001 To 22000: VisualEq(9) = VisualEq(9) + Abs(RealPart(k)) * Vol | | End Select | | | | | | RealPart(k) = RealPart(k) * Vol | | ImagPart(k) = ImagPart(k) * Vol | | RealPartR(k) = RealPartR(k) * Vol | | ImagPartR(k) = ImagPartR(k) * Vol | | Next k | | | | | | Call IFFT(RealPart(), ImagPart(), N) | | Call IFFT(RealPartR(), ImagPartR(), N) | | | | | | | | | | Dim origRMS As Single, newRMS As Single | | origRMS = 0: newRMS = 0 | | For i = 0 To N - 1 | | origRMS = origRMS + (Blok(i) * Blok(i)) | | newRMS = newRMS + (RealPart(i) * RealPart(i)) | | Next i | | origRMS = Sqr(origRMS / N) | | newRMS = Sqr(newRMS / N) | | Dim newScale As Single | | If newRMS > 0 Then | | newScale = origRMS / newRMS | | Else | | newScale = 1 | | End If | | Dim smoothing As Single | | smoothing = 0.3 | | Dim scaleFactor As Single | | scaleFactor = smoothing * prevScaleFactor + (1 - smoothing) * newScale | | prevScaleFactor = scaleFactor | | For i = 0 To N - 1 | | RealPart(i) = RealPart(i) * scaleFactor | | RealPartR(i) = RealPartR(i) * scaleFactor | | Next i | | | | | | For i = 0 To N - 1 | | If RealPart(i) > 0.95 Then RealPart(i) = 0.95 | | If RealPart(i) < -0.95 Then RealPart(i) = -0.95 | | If RealPartR(i) > 0.95 Then RealPartR(i) = 0.95 | | If RealPartR(i) < -0.95 Then RealPartR(i) = -0.95 | | _SndRaw RealPart(i), RealPartR(i) | | Next i | | | | | | Cls | | For EqBand = 0 To 9 | | VisualEq(EqBand) = VisualEq(EqBand) / N | | BarHeight = VisualEq(EqBand) * 400 | | Line (EqBand * 80 + 20, 600)-(EqBand * 80 + 60, 600 - BarHeight), Colors(EqBand), BF | | Next EqBand | | | | | | Do Until _SndRawLen < 0.05 | | i$ = InKey$ | | Select Case LCase$(i$) | | Case "q": Eq(0) = Eq(0) + 0.1 | | Case "a": Eq(0) = Eq(0) - 0.1 | | Case "w": Eq(1) = Eq(1) + 0.1 | | Case "s": Eq(1) = Eq(1) - 0.1 | | Case "e": Eq(2) = Eq(2) + 0.1 | | Case "d": Eq(2) = Eq(2) - 0.1 | | Case "r": Eq(3) = Eq(3) + 0.1 | | Case "f": Eq(3) = Eq(3) - 0.1 | | Case "t": Eq(4) = Eq(4) + 0.1 | | Case "g": Eq(4) = Eq(4) - 0.1 | | Case "y": Eq(5) = Eq(5) + 0.1 | | Case "h": Eq(5) = Eq(5) - 0.1 | | Case "u": Eq(6) = Eq(6) + 0.1 | | Case "j": Eq(6) = Eq(6) - 0.1 | | Case "i": Eq(7) = Eq(7) + 0.1 | | Case "k": Eq(7) = Eq(7) - 0.1 | | Case "o": Eq(8) = Eq(8) + 0.1 | | Case "l": Eq(8) = Eq(8) - 0.1 | | Case "p": Eq(9) = Eq(9) + 0.1 | | Case ";": Eq(9) = Eq(9) - 0.1 | | End Select | | | | Locate 4 | | Print " Use keys for equalize:" | | Print | | Print " q/a [2-64 Hz] "; Int((Eq(0) - 2) * 100); "% " | | Print " w/s [65-125 Hz] "; Int((Eq(1) - 2) * 100); "% " | | Print " e/d [126-250 Hz] "; Int((Eq(2) - 2) * 100); "% " | | Print " r/f [251-500 Hz] "; Int((Eq(3) - 2) * 100); "% " | | Print " t/g [501-1000 Hz] "; Int((Eq(4) - 2) * 100); "% " | | Print " y/h [1001-2000 Hz] "; Int((Eq(5) - 2) * 100); "% " | | Print " u/j [2001-4000 Hz] "; Int((Eq(6) - 2) * 100); "% " | | Print " i/k [4001-8000 Hz] "; Int((Eq(7) - 2) * 100); "% " | | Print " o/l [8001-16000 Hz] "; Int((Eq(8) - 2) * 100); "% " | | Print " p/; [16001-22000 Hz] "; Int((Eq(9) - 2) * 100); "% " | | _Display | | | | For EqVolsTest = 0 To 9 | | If Eq(EqVolsTest) > 6 Then Eq(EqVolsTest) = 6 | | If Eq(EqVolsTest) < 0 Then Eq(EqVolsTest) = 0 | | Next | | Loop | | | | 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 | | | | | | 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 | | | | For i = 0 To N - 1 | | ImagPart(i) = -ImagPart(i) | | Next i | | | | Call FFT(RealPart(), ImagPart(), N) | | | | For i = 0 To N - 1 | | RealPart(i) = RealPart(i) / N | | ImagPart(i) = -ImagPart(i) / N | | Next i | | End Sub |
Version 2 - Better, but not best
Code: (Select All)
| | | | | | | | | _Title "QB64PE Sound Equalizer with Overlap-Add" | | | | | | Zdroj = _SndOpen("b.mp3") | | Dim Zvuk As _MEM | | Zvuk = _MemSound(Zdroj, 0) | | | | | | Const blockSize = 2048 | | Const hopSize = blockSize / 2 | | | | Dim A As Long | | | | | | Dim InL(blockSize - 1) As Single | | Dim InR(blockSize - 1) As Single | | | | | | Dim synthesisL(blockSize - 1) As Single | | Dim synthesisR(blockSize - 1) As Single | | | | | | Dim RealPart(blockSize - 1) As Single, ImagPart(blockSize - 1) As Single | | Dim RealPartR(blockSize - 1) As Single, ImagPartR(blockSize - 1) As Single | | | | | | Dim Eq(9) As Single | | For FillEq = 0 To 9 | | Eq(FillEq) = 2 | | Next | | | | | | Dim VzorkovaciFrekvence As Single | | VzorkovaciFrekvence = _SndRate | | | | | | 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) | | | | | | Dim Korekce(9) As Single | | Korekce(0) = 2.0 | | Korekce(1) = 1.8 | | Korekce(2) = 1.5 | | Korekce(3) = 1.2 | | Korekce(4) = 1.0 | | Korekce(5) = 0.8 | | Korekce(6) = 0.7 | | Korekce(7) = 0.6 | | Korekce(8) = 0.5 | | Korekce(9) = 0.4 | | | | Screen _NewImage(800, 600, 32) | | | | | | Dim prevScaleFactor As Single | | prevScaleFactor = 1 | | | | | | | | For i = 0 To blockSize - 1 | | If A >= Zvuk.SIZE Then Exit For | | Dim LevaStopa As Single, PravaStopa As Single | | LevaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A, Single) | | PravaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A + 4, Single) | | InL(i) = LevaStopa | | InR(i) = PravaStopa | | A = A + 8 | | Next i | | | | | | For i = 0 To blockSize - 1 | | synthesisL(i) = 0 | | synthesisR(i) = 0 | | Next i | | | | | | | | Do While A < Zvuk.SIZE | | | | For EqBand = 0 To 9 | | VisualEq(EqBand) = 0 | | Next EqBand | | | | | | | | | | | | | | | | | | | | For i = 0 To blockSize - 1 | | RealPart(i) = InL(i) | | RealPartR(i) = InR(i) | | ImagPart(i) = 0 | | ImagPartR(i) = 0 | | Next i | | | | | | | | | | | | | | For i = 0 To blockSize - 1 | | factor = 0.5 - 0.5 * Cos(2 * 3.14159265359 * i / (blockSize - 1)) | | RealPart(i) = RealPart(i) * factor | | RealPartR(i) = RealPartR(i) * factor | | Next i | | | | | | | | | | Call FFT(RealPart(), ImagPart(), blockSize) | | Call FFT(RealPartR(), ImagPartR(), blockSize) | | | | | | | | | | | | | | For k = 0 To blockSize - 1 | | Frekvence = k * VzorkovaciFrekvence / blockSize | | Dim Vol As Single, t As Single | | If Frekvence < 2 Or Frekvence > 22000 Then | | Vol = 1 | | ElseIf Frekvence < 64 Then | | Vol = Eq(0) * Korekce(0) | | ElseIf Frekvence < 65 Then | | t = (Frekvence - 64) / 1 | | Vol = (1 - t) * (Eq(0) * Korekce(0)) + t * (Eq(1) * Korekce(1)) | | ElseIf Frekvence < 125 Then | | Vol = Eq(1) * Korekce(1) | | ElseIf Frekvence < 126 Then | | t = (Frekvence - 125) / 1 | | Vol = (1 - t) * (Eq(1) * Korekce(1)) + t * (Eq(2) * Korekce(2)) | | ElseIf Frekvence < 250 Then | | Vol = Eq(2) * Korekce(2) | | ElseIf Frekvence < 251 Then | | t = (Frekvence - 250) / 1 | | Vol = (1 - t) * (Eq(2) * Korekce(2)) + t * (Eq(3) * Korekce(3)) | | ElseIf Frekvence < 500 Then | | Vol = Eq(3) * Korekce(3) | | ElseIf Frekvence < 501 Then | | t = (Frekvence - 500) / 1 | | Vol = (1 - t) * (Eq(3) * Korekce(3)) + t * (Eq(4) * Korekce(4)) | | ElseIf Frekvence < 1000 Then | | Vol = Eq(4) * Korekce(4) | | ElseIf Frekvence < 1001 Then | | t = (Frekvence - 1000) / 1 | | Vol = (1 - t) * (Eq(4) * Korekce(4)) + t * (Eq(5) * Korekce(5)) | | ElseIf Frekvence < 2000 Then | | Vol = Eq(5) * Korekce(5) | | ElseIf Frekvence < 2001 Then | | t = (Frekvence - 2000) / 1 | | Vol = (1 - t) * (Eq(5) * Korekce(5)) + t * (Eq(6) * Korekce(6)) | | ElseIf Frekvence < 4000 Then | | Vol = Eq(6) * Korekce(6) | | ElseIf Frekvence < 4001 Then | | t = (Frekvence - 4000) / 1 | | Vol = (1 - t) * (Eq(6) * Korekce(6)) + t * (Eq(7) * Korekce(7)) | | ElseIf Frekvence < 8000 Then | | Vol = Eq(7) * Korekce(7) | | ElseIf Frekvence < 8001 Then | | t = (Frekvence - 8000) / 1 | | Vol = (1 - t) * (Eq(7) * Korekce(7)) + t * (Eq(8) * Korekce(8)) | | ElseIf Frekvence < 16000 Then | | Vol = Eq(8) * Korekce(8) | | ElseIf Frekvence < 16001 Then | | t = (Frekvence - 16000) / 1 | | Vol = (1 - t) * (Eq(8) * Korekce(8)) + t * (Eq(9) * Korekce(9)) | | Else | | Vol = Eq(9) * Korekce(9) | | End If | | | | | | Select Case Frekvence | | Case 2 To 64: VisualEq(0) = VisualEq(0) + Abs(RealPart(k)) * Vol | | Case 65 To 125: VisualEq(1) = VisualEq(1) + Abs(RealPart(k)) * Vol | | Case 126 To 250: VisualEq(2) = VisualEq(2) + Abs(RealPart(k)) * Vol | | Case 251 To 500: VisualEq(3) = VisualEq(3) + Abs(RealPart(k)) * Vol | | Case 501 To 1000: VisualEq(4) = VisualEq(4) + Abs(RealPart(k)) * Vol | | Case 1001 To 2000: VisualEq(5) = VisualEq(5) + Abs(RealPart(k)) * Vol | | Case 2001 To 4000: VisualEq(6) = VisualEq(6) + Abs(RealPart(k)) * Vol | | Case 4001 To 8000: VisualEq(7) = VisualEq(7) + Abs(RealPart(k)) * Vol | | Case 8001 To 16000: VisualEq(8) = VisualEq(8) + Abs(RealPart(k)) * Vol | | Case 16001 To 22000: VisualEq(9) = VisualEq(9) + Abs(RealPart(k)) * Vol | | End Select | | | | | | RealPart(k) = RealPart(k) * Vol | | ImagPart(k) = ImagPart(k) * Vol | | RealPartR(k) = RealPartR(k) * Vol | | ImagPartR(k) = ImagPartR(k) * Vol | | Next k | | | | | | | | | | Call IFFT(RealPart(), ImagPart(), blockSize) | | Call IFFT(RealPartR(), ImagPartR(), blockSize) | | | | | | | | | | | | | | Dim origRMS As Single, newRMS As Single | | origRMS = 0: newRMS = 0 | | For i = 0 To blockSize - 1 | | origRMS = origRMS + (InL(i) * InL(i)) | | newRMS = newRMS + (RealPart(i) * RealPart(i)) | | Next i | | origRMS = Sqr(origRMS / blockSize) | | newRMS = Sqr(newRMS / blockSize) | | Dim newScale As Single | | If newRMS > 0 Then | | newScale = origRMS / newRMS | | Else | | newScale = 1 | | End If | | Dim smoothing As Single | | smoothing = 0.3 | | Dim scaleFactor As Single | | scaleFactor = smoothing * prevScaleFactor + (1 - smoothing) * newScale | | prevScaleFactor = scaleFactor | | For i = 0 To blockSize - 1 | | RealPart(i) = RealPart(i) * scaleFactor | | RealPartR(i) = RealPartR(i) * scaleFactor | | Next i | | | | | | | | | | | | For i = 0 To blockSize - 1 | | synthesisL(i) = synthesisL(i) + RealPart(i) | | synthesisR(i) = synthesisR(i) + RealPartR(i) | | Next i | | | | | | For i = 0 To hopSize - 1 | | Dim outL As Single, outR As Single | | outL = synthesisL(i) | | outR = synthesisR(i) | | | | If outL > 0.95 Then outL = 0.95 | | If outL < -0.95 Then outL = -0.95 | | If outR > 0.95 Then outR = 0.95 | | If outR < -0.95 Then outR = -0.95 | | _SndRaw outL, outR | | Next i | | | | | | For i = 0 To blockSize - hopSize - 1 | | synthesisL(i) = synthesisL(i + hopSize) | | synthesisR(i) = synthesisR(i + hopSize) | | Next i | | For i = blockSize - hopSize To blockSize - 1 | | synthesisL(i) = 0 | | synthesisR(i) = 0 | | Next i | | | | | | | | | | | | | | For i = 0 To hopSize - 1 | | InL(i) = InL(i + hopSize) | | InR(i) = InR(i + hopSize) | | Next i | | For i = hopSize To blockSize - 1 | | If A >= Zvuk.SIZE Then | | InL(i) = 0 | | InR(i) = 0 | | Else | | LevaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A, Single) | | PravaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A + 4, Single) | | InL(i) = LevaStopa | | InR(i) = PravaStopa | | A = A + 8 | | End If | | Next i | | | | | | | | | | | | | | Cls | | For EqBand = 0 To 9 | | VisualEq(EqBand) = VisualEq(EqBand) / blockSize | | BarHeight = VisualEq(EqBand) * 400 | | Line (EqBand * 80 + 20, 600)-(EqBand * 80 + 60, 600 - BarHeight), Colors(EqBand), BF | | Next EqBand | | | | Do Until _SndRawLen < 0.05 | | Dim i As String | | i$ = InKey$ | | Select Case LCase$(i$) | | Case "q": Eq(0) = Eq(0) + 0.1 | | Case "a": Eq(0) = Eq(0) - 0.1 | | Case "w": Eq(1) = Eq(1) + 0.1 | | Case "s": Eq(1) = Eq(1) - 0.1 | | Case "e": Eq(2) = Eq(2) + 0.1 | | Case "d": Eq(2) = Eq(2) - 0.1 | | Case "r": Eq(3) = Eq(3) + 0.1 | | Case "f": Eq(3) = Eq(3) - 0.1 | | Case "t": Eq(4) = Eq(4) + 0.1 | | Case "g": Eq(4) = Eq(4) - 0.1 | | Case "y": Eq(5) = Eq(5) + 0.1 | | Case "h": Eq(5) = Eq(5) - 0.1 | | Case "u": Eq(6) = Eq(6) + 0.1 | | Case "j": Eq(6) = Eq(6) - 0.1 | | Case "i": Eq(7) = Eq(7) + 0.1 | | Case "k": Eq(7) = Eq(7) - 0.1 | | Case "o": Eq(8) = Eq(8) + 0.1 | | Case "l": Eq(8) = Eq(8) - 0.1 | | Case "p": Eq(9) = Eq(9) + 0.1 | | Case ";": Eq(9) = Eq(9) - 0.1 | | End Select | | | | Locate 4 | | Print " Use keys for equalize:" | | Print | | Print " q/a [2-64 Hz] "; Int((Eq(0) - 2) * 100); "% " | | Print " w/s [65-125 Hz] "; Int((Eq(1) - 2) * 100); "% " | | Print " e/d [126-250 Hz] "; Int((Eq(2) - 2) * 100); "% " | | Print " r/f [251-500 Hz] "; Int((Eq(3) - 2) * 100); "% " | | Print " t/g [501-1000 Hz] "; Int((Eq(4) - 2) * 100); "% " | | Print " y/h [1001-2000 Hz] "; Int((Eq(5) - 2) * 100); "% " | | Print " u/j [2001-4000 Hz] "; Int((Eq(6) - 2) * 100); "% " | | Print " i/k [4001-8000 Hz] "; Int((Eq(7) - 2) * 100); "% " | | Print " o/l [8001-16000 Hz] "; Int((Eq(8) - 2) * 100); "% " | | Print " p/; [16001-22000 Hz] "; Int((Eq(9) - 2) * 100); "% " | | _Display | | | | For EqVolsTest = 0 To 9 | | If Eq(EqVolsTest) > 6 Then Eq(EqVolsTest) = 6 | | If Eq(EqVolsTest) < 0 Then Eq(EqVolsTest) = 0 | | Next | | Loop | | | | 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 | | | | | | 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 | | | | For i = 0 To N - 1 | | ImagPart(i) = -ImagPart(i) | | Next i | | | | Call FFT(RealPart(), ImagPart(), N) | | | | For i = 0 To N - 1 | | RealPart(i) = RealPart(i) / N | | ImagPart(i) = -ImagPart(i) / N | | Next i | | End Sub |
Version three - best. No clicking!
Code: (Select All)
| | | | | | | | | _Title "QB64PE Sound Equalizer with Overlap-Add" | | | | | | Zdroj = _SndOpen("b.mp3") | | Dim Zvuk As _MEM | | Zvuk = _MemSound(Zdroj, 0) | | | | | | Const blockSize = 4096 | | Const hopSize = blockSize / 2 | | | | Dim A As Long | | | | | | Dim InL(blockSize - 1) As Single | | Dim InR(blockSize - 1) As Single | | | | | | Dim synthesisL(blockSize - 1) As Single | | Dim synthesisR(blockSize - 1) As Single | | | | | | Dim RealPart(blockSize - 1) As Single, ImagPart(blockSize - 1) As Single | | Dim RealPartR(blockSize - 1) As Single, ImagPartR(blockSize - 1) As Single | | | | | | Dim Eq(9) As Single | | For FillEq = 0 To 9 | | Eq(FillEq) = 3 | | Next | | | | | | Dim VzorkovaciFrekvence As Single | | VzorkovaciFrekvence = _SndRate | | | | | | 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) | | | | | | Dim Korekce(9) As Single | | Korekce(0) = 2.0 | | Korekce(1) = 1.8 | | Korekce(2) = 1.5 | | Korekce(3) = 1.2 | | Korekce(4) = 1.0 | | Korekce(5) = 0.8 | | Korekce(6) = 0.7 | | Korekce(7) = 0.6 | | Korekce(8) = 0.5 | | Korekce(9) = 0.4 | | | | Screen _NewImage(800, 600, 32) | | | | | | Dim prevScaleFactor As Single | | prevScaleFactor = 1 | | | | | | | | For i = 0 To blockSize - 1 | | If A >= Zvuk.SIZE Then Exit For | | Dim LevaStopa As Single, PravaStopa As Single | | LevaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A, Single) | | PravaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A + 4, Single) | | InL(i) = LevaStopa | | InR(i) = PravaStopa | | A = A + 8 | | Next i | | | | | | For i = 0 To blockSize - 1 | | synthesisL(i) = 0 | | synthesisR(i) = 0 | | Next i | | | | | | | | Do While A < Zvuk.SIZE | | | | For EqBand = 0 To 9 | | VisualEq(EqBand) = 0 | | Next EqBand | | | | | | | | | | | | | | | | | | | | For i = 0 To blockSize - 1 | | RealPart(i) = InL(i) | | RealPartR(i) = InR(i) | | ImagPart(i) = 0 | | ImagPartR(i) = 0 | | Next i | | | | | | | | | | | | | | For i = 0 To blockSize - 1 | | factor = 0.5 - 0.5 * Cos(2 * 3.14159265359 * i / (blockSize - 1)) | | RealPart(i) = RealPart(i) * factor | | RealPartR(i) = RealPartR(i) * factor | | Next i | | | | | | | | | | Call FFT(RealPart(), ImagPart(), blockSize) | | Call FFT(RealPartR(), ImagPartR(), blockSize) | | | | | | | | | | | | | | For k = 0 To blockSize - 1 | | Frekvence = k * VzorkovaciFrekvence / blockSize | | Dim Vol As Single, t As Single | | | | | | | | If Frekvence < 40 Then | | Vol = Eq(0) * Korekce(0) | | ElseIf Frekvence < 41 Then | | | | t = (Frekvence - 40) / 1 | | Vol = (1 - t) * (Eq(0) * Korekce(0)) + t * (Eq(1) * Korekce(1)) | | ElseIf Frekvence < 125 Then | | Vol = Eq(1) * Korekce(1) | | ElseIf Frekvence < 126 Then | | t = (Frekvence - 125) / 1 | | Vol = (1 - t) * (Eq(1) * Korekce(1)) + t * (Eq(2) * Korekce(2)) | | ElseIf Frekvence < 250 Then | | Vol = Eq(2) * Korekce(2) | | ElseIf Frekvence < 251 Then | | t = (Frekvence - 250) / 1 | | Vol = (1 - t) * (Eq(2) * Korekce(2)) + t * (Eq(3) * Korekce(3)) | | ElseIf Frekvence < 500 Then | | Vol = Eq(3) * Korekce(3) | | ElseIf Frekvence < 501 Then | | t = (Frekvence - 500) / 1 | | Vol = (1 - t) * (Eq(3) * Korekce(3)) + t * (Eq(4) * Korekce(4)) | | ElseIf Frekvence < 1000 Then | | Vol = Eq(4) * Korekce(4) | | ElseIf Frekvence < 1001 Then | | t = (Frekvence - 1000) / 1 | | Vol = (1 - t) * (Eq(4) * Korekce(4)) + t * (Eq(5) * Korekce(5)) | | ElseIf Frekvence < 2000 Then | | Vol = Eq(5) * Korekce(5) | | ElseIf Frekvence < 2001 Then | | t = (Frekvence - 2000) / 1 | | Vol = (1 - t) * (Eq(5) * Korekce(5)) + t * (Eq(6) * Korekce(6)) | | ElseIf Frekvence < 4000 Then | | Vol = Eq(6) * Korekce(6) | | ElseIf Frekvence < 4001 Then | | t = (Frekvence - 4000) / 1 | | Vol = (1 - t) * (Eq(6) * Korekce(6)) + t * (Eq(7) * Korekce(7)) | | ElseIf Frekvence < 8000 Then | | Vol = Eq(7) * Korekce(7) | | ElseIf Frekvence < 8001 Then | | t = (Frekvence - 8000) / 1 | | Vol = (1 - t) * (Eq(7) * Korekce(7)) + t * (Eq(8) * Korekce(8)) | | ElseIf Frekvence < 16000 Then | | Vol = Eq(8) * Korekce(8) | | ElseIf Frekvence < 16001 Then | | t = (Frekvence - 16000) / 1 | | Vol = (1 - t) * (Eq(8) * Korekce(8)) + t * (Eq(9) * Korekce(9)) | | Else | | Vol = Eq(9) * Korekce(9) | | End If | | | | | | Select Case Frekvence | | | | Case 65 To 125: VisualEq(1) = VisualEq(1) + Abs(RealPart(k)) * Vol | | Case 126 To 250: VisualEq(2) = VisualEq(2) + Abs(RealPart(k)) * Vol | | Case 251 To 500: VisualEq(3) = VisualEq(3) + Abs(RealPart(k)) * Vol | | Case 501 To 1000: VisualEq(4) = VisualEq(4) + Abs(RealPart(k)) * Vol | | Case 1001 To 2000: VisualEq(5) = VisualEq(5) + Abs(RealPart(k)) * Vol | | Case 2001 To 4000: VisualEq(6) = VisualEq(6) + Abs(RealPart(k)) * Vol | | Case 4001 To 8000: VisualEq(7) = VisualEq(7) + Abs(RealPart(k)) * Vol | | Case 8001 To 16000: VisualEq(8) = VisualEq(8) + Abs(RealPart(k)) * Vol | | Case 16001 To 22000: VisualEq(9) = VisualEq(9) + Abs(RealPart(k)) * Vol | | End Select | | | | RealPart(k) = RealPart(k) * Vol | | ImagPart(k) = ImagPart(k) * Vol | | RealPartR(k) = RealPartR(k) * Vol | | ImagPartR(k) = ImagPartR(k) * Vol | | Next k | | | | | | | | Call IFFT(RealPart(), ImagPart(), blockSize) | | Call IFFT(RealPartR(), ImagPartR(), blockSize) | | | | | | | | | | | | | | Dim origRMS As Single, newRMS As Single | | origRMS = 0: newRMS = 0 | | For i = 0 To blockSize - 1 | | origRMS = origRMS + (InL(i) * InL(i)) | | newRMS = newRMS + (RealPart(i) * RealPart(i)) | | Next i | | origRMS = Sqr(origRMS / blockSize) | | newRMS = Sqr(newRMS / blockSize) | | Dim newScale As Single | | If newRMS > 0 Then | | newScale = origRMS / newRMS | | Else | | newScale = 1 | | End If | | Dim smoothing As Single | | smoothing = 0.3 | | Dim scaleFactor As Single | | scaleFactor = smoothing * prevScaleFactor + (1 - smoothing) * newScale | | prevScaleFactor = scaleFactor | | For i = 0 To blockSize - 1 | | RealPart(i) = RealPart(i) * scaleFactor | | RealPartR(i) = RealPartR(i) * scaleFactor | | Next i | | | | | | | | | | | | For i = 0 To blockSize - 1 | | synthesisL(i) = synthesisL(i) + RealPart(i) | | synthesisR(i) = synthesisR(i) + RealPartR(i) | | Next i | | | | | | For i = 0 To hopSize - 1 | | Dim outL As Single, outR As Single | | outL = synthesisL(i) | | outR = synthesisR(i) | | | | If outL > 0.95 Then outL = 0.95 | | If outL < -0.95 Then outL = -0.95 | | If outR > 0.95 Then outR = 0.95 | | If outR < -0.95 Then outR = -0.95 | | _SndRaw outL, outR | | Next i | | | | | | For i = 0 To blockSize - hopSize - 1 | | synthesisL(i) = synthesisL(i + hopSize) | | synthesisR(i) = synthesisR(i + hopSize) | | Next i | | For i = blockSize - hopSize To blockSize - 1 | | synthesisL(i) = 0 | | synthesisR(i) = 0 | | Next i | | | | | | | | | | | | | | For i = 0 To hopSize - 1 | | InL(i) = InL(i + hopSize) | | InR(i) = InR(i + hopSize) | | Next i | | For i = hopSize To blockSize - 1 | | If A >= Zvuk.SIZE Then | | InL(i) = 0 | | InR(i) = 0 | | Else | | LevaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A, Single) | | PravaStopa = _MemGet(Zvuk, Zvuk.OFFSET + A + 4, Single) | | InL(i) = LevaStopa | | InR(i) = PravaStopa | | A = A + 8 | | End If | | Next i | | | | | | | | | | | | | | Cls | | For EqBand = 1 To 9 | | VisualEq(EqBand) = VisualEq(EqBand) / blockSize | | BarHeight = VisualEq(EqBand) * 400 | | Line (EqBand * 80 + 20, 600)-(EqBand * 80 + 60, 600 - BarHeight), Colors(EqBand), BF | | Next EqBand | | | | Do Until _SndRawLen < 0.05 | | Dim i As String | | i$ = InKey$ | | Select Case LCase$(i$) | | | | | | Case "w": Eq(1) = Eq(1) + 0.1 | | Case "s": Eq(1) = Eq(1) - 0.1 | | Case "e": Eq(2) = Eq(2) + 0.1 | | Case "d": Eq(2) = Eq(2) - 0.1 | | Case "r": Eq(3) = Eq(3) + 0.1 | | Case "f": Eq(3) = Eq(3) - 0.1 | | Case "t": Eq(4) = Eq(4) + 0.1 | | Case "g": Eq(4) = Eq(4) - 0.1 | | Case "y": Eq(5) = Eq(5) + 0.1 | | Case "h": Eq(5) = Eq(5) - 0.1 | | Case "u": Eq(6) = Eq(6) + 0.1 | | Case "j": Eq(6) = Eq(6) - 0.1 | | Case "i": Eq(7) = Eq(7) + 0.1 | | Case "k": Eq(7) = Eq(7) - 0.1 | | Case "o": Eq(8) = Eq(8) + 0.1 | | Case "l": Eq(8) = Eq(8) - 0.1 | | Case "p": Eq(9) = Eq(9) + 0.1 | | Case ";": Eq(9) = Eq(9) - 0.1 | | End Select | | | | Locate 4 | | Print " Use keys for equalize:" | | Print | | | | Print " w/s [65-125 Hz] "; Int((Eq(1) - 3) * 100); "% " | | Print " e/d [126-250 Hz] "; Int((Eq(2) - 3) * 100); "% " | | Print " r/f [251-500 Hz] "; Int((Eq(3) - 3) * 100); "% " | | Print " t/g [501-1000 Hz] "; Int((Eq(4) - 3) * 100); "% " | | Print " y/h [1001-2000 Hz] "; Int((Eq(5) - 3) * 100); "% " | | Print " u/j [2001-4000 Hz] "; Int((Eq(6) - 3) * 100); "% " | | Print " i/k [4001-8000 Hz] "; Int((Eq(7) - 3) * 100); "% " | | Print " o/l [8001-16000 Hz] "; Int((Eq(8) - 3) * 100); "% " | | Print " p/; [16001-22000 Hz] "; Int((Eq(9) - 3) * 100); "% " | | _Display | | | | For EqVolsTest = 1 To 9 | | If Eq(EqVolsTest) > 6 Then Eq(EqVolsTest) = 6 | | If Eq(EqVolsTest) < 0 Then Eq(EqVolsTest) = 0 | | Next | | Loop | | | | 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 | | | | | | 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 | | | | For i = 0 To N - 1 | | ImagPart(i) = -ImagPart(i) | | Next i | | | | Call FFT(RealPart(), ImagPart(), N) | | | | For i = 0 To N - 1 | | RealPart(i) = RealPart(i) / N | | ImagPart(i) = -ImagPart(i) / N | | Next i | | End Sub |
Posts: 2,577
Threads: 264
Joined: Apr 2022
Reputation:
140
Three sound examples of sound examples.
+2
Pete
|
