01-05-2025, 05:52 AM
Tonight I threw this together using code from my Tesla Coil simulator.
I've tested a midi and mp3's on it so far.
I know others have made stuff like this, I remember awhile back Petr made one. It gave me inspiration to make my own.
I am tossing in 2001.mid song also to download here to play with it, check it out.
I've tested a midi and mp3's on it so far.
I know others have made stuff like this, I remember awhile back Petr made one. It gave me inspiration to make my own.
I am tossing in 2001.mid song also to download here to play with it, check it out.
Code: (Select All)
'Audio Spectrum Analyser by SierraKen
'January 4, 2025
'Thank you for the frequency example at the QB64 Wiki Help Page https://qb64phoenix.com/qb64wiki/index.php/MEMSOUND
_Title "Audio Spectrum Analyser - By SierraKen"
Screen _NewImage(800, 600, 32)
Dim tim As Single
Dim tim2 As Single
Dim yn$
start:
Clear
Cls
Dim file$
Dim press As Single
file$ = ""
Line (300, 100)-(550, 200), _RGB32(255, 255, 255), BF
Color _RGB32(255, 0, 0), _RGB(255, 255, 255)
_PrintString (330, 150), "Click Here To Load Music"
Do
Do
While _MouseInput
If _MouseButton(1) And _MouseX > 300 And _MouseX < 550 And _MouseY > 100 And _MouseY < 200 Then press = 1
Wend
Loop Until press = 1
start2:
Line (300, 100)-(550, 200), _RGB32(255, 0, 0), BF
tim = Timer
Do
tim2 = Timer
If tim2 - tim > .5 Then
Line (300, 100)-(550, 200), _RGB32(255, 255, 255), BF
Timer Off
Exit Do
End If
Loop
tim = 0: tim2 = 0
Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)
Print
file$ = _OpenFileDialog$(, "Music File")
If file$ = "" Then
Locate 6, 70: Print " "
Locate 6, 38
Input "Would you like to continue (Y/N)", yn$
If Left$(yn$, 1) = "y" Or Left$(yn$, 1) = "Y" Then
GoTo start2:
End If
End If
Loop Until press = 1
press = 0
yn$ = ""
DefLng A-Z
Dim x4 As Single
Dim y4 As Single
Dim a$
Print "Loading...";
Dim Song As Long
Song = _SndOpen(file$) ' Replace this with your (rad, mid, it, xm, s3m, mod, mp3, flac, ogg, wav) sound file
If Song < 1 Then
End
End If
_Display
_SndPlay Song
Dim SampleData As _MEM
SampleData = _MemSound(Song, 1) ' This can now be 0 or 1
If SampleData.SIZE = 0 Then
Print "Failed to access sound sample data."
End
End If
Dim y As Long, i As _Unsigned _Integer64, sf As Single, si As Integer
Dim sz As _Unsigned _Integer64
y4 = 300
x4 = 200
sz = _CV(_Unsigned _Integer64, _MK$(_Offset, SampleData.ELEMENTSIZE)) ' sz is the total size of the sound in bytes
Cls
Do Until Not _SndPlaying(Song) Or i + (_Width * sz) > SampleData.SIZE
a$ = InKey$
If a$ = Chr$(27) Then _SndClose Song: End
Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 10), BF
Locate 1, 1: Print i; "/"; SampleData.SIZE, "Frame Size ="; sz, "Data Type ="; SampleData.TYPE
'If (sz = 4 Or sz = 2) And SampleData.TYPE = 1 Then ' integer stereo or mono
If (sz = 4 Or sz = 2) And (SampleData.TYPE And 128) Then
For y = 0 To _Width - 1
si = _MemGet(SampleData, SampleData.OFFSET + i + y * sz, Integer) 'get sound data
If 300 * si / 32768 = 0 Then GoTo skip:
If sf * 300 = 0 Then GoTo skip:
tt = tt + 1
If tt > 700 Then tt = 1
If tt / 5 <> Int(tt / 5) Then GoTo skipp2:
oldy4 = y4: oldx4 = x4
y4 = (sf * 400) + 400
x4 = (sf * 300) + 50
Line (oldx4 + tt, oldy4)-(x4 + tt, y4), _RGB32(0, 255, 0)
skipp2:
Next
'ElseIf (sz = 8 Or sz = 4) And SampleData.TYPE = 4 Then ' floating point stereo or mono
ElseIf (sz = 8 Or sz = 4) And (SampleData.TYPE And 256) Then
For y = 500 To 1 Step -1
sf = _MemGet(SampleData, SampleData.OFFSET + i + y * sz, Single) 'get sound data
If sf * 300 = 0 Then GoTo skip:
tt = tt + 1
If tt > 700 Then tt = 1
If tt / 5 <> Int(tt / 5) Then GoTo skipp:
oldy4 = y4: oldx4 = x4
y4 = (sf * 400) + 400
x4 = (sf * 300) + 50
Line (oldx4 + tt, oldy4)-(x4 + tt, y4), _RGB32(0, 255, 0)
skipp:
Next
ElseIf sz = 2 And SampleData.TYPE = 0 Then ' integer mono (QB64 OpenAL stuff)
For y = 0 To _Width - 1
si = _MemGet(SampleData, SampleData.OFFSET + i + y * sz, Integer) 'get sound data
If 300 * si / 32768 = 0 Then GoTo skip:
If sf * 300 = 0 Then GoTo skip:
tt = tt + 1
If tt > 700 Then tt = 1
If tt / 5 <> Int(tt / 5) Then GoTo skipp3:
oldy4 = y4: oldx4 = x4
y4 = (sf * 400) + 400
x4 = (sf * 300) + 50
Line (oldx4 + tt, oldy4)-(x4 + tt, y4), _RGB32(0, 255, 0)
skipp3:
Next
End If
skip:
$Checking:On
_Display
_Limit 60
i = Fix(_SndGetPos(Song) * _SndRate) * sz ' Calculate the new sample frame position
Loop
_SndClose Song 'closing the sound releases the mem blocks
_AutoDisplay
GoTo start:
