QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: Richard on June 10, 2021, 05:04:29 am

Title: Sound Recorder with additional tracks?
Post by: Richard on June 10, 2021, 05:04:29 am

Does anyone have a QB64 sound recording program and can it also incorporate a time stamp?

The epoch (say) timestamp should not interfere with the audio but it would be acceptable to have say

time stamp - x seconds audio - time stamp - x seconds audio - time stamp ....

Ideally the program is compact (very few features) and the recording can be played on "free" software or another QB64 program.

Any choice on audio dynamic range (8 bits .... 64 bits)?

Availablity to record two audios, not necessarily stereo, would be a plus.

Title: Re: Sound Recorder with additional tracks?
Post by: SpriggsySpriggs on June 10, 2021, 12:06:05 pm

You'd have to learn the MCI commands so you can take advantage of some more advanced features but here is a recording application I made in QB64 using the WINMM DLL. It opens up a wav file and writes to it until you press a key. It saves the recording and then plays it back. The code also uses Fellippe's code showcasing MEMSOUND to show waveforms of audio.

Code: QB64: [Select]

1. Option _Explicit
2.  
3. _Title "mciSendString Record Test"
4.  
5. Dim x, y
6. StartRecording
7.  
8. x = Timer(0.01)
9. Do
10.     y = Timer(0.01)
11.     Cls
12.     Print "Recording...Press any key to stop"
13.     Print y - x
14.     _Display
15. Loop Until InKey$ <> ""
16.  
17. StopRecording
18. SaveRecording ("test.wav")
19.  
20. _Title "Waveform Display"
21. ShowWaveForm "test.wav"
22.  
23. Declare Dynamic Library "WINMM"
24.     Function mciSendString& Alias "mciSendStringA" (lpstrCommand As String, lpstrReturnString As String, Byval uReturnLength As _Unsigned Long, Byval hwndCallback As Long)
25.     Function mciGetErrorString& Alias "mciGetErrorStringA" (ByVal dwError As Long, lpstrBuffer As String, Byval uLength As _Unsigned Long)
26. End Declare
27.  
28. Sub StartRecording
29.     Dim As Long a
30.     a = mciSendString("open new type waveaudio alias capture" + Chr$(0), "", 0, 0)
31.     If a Then
32.         Dim As Long x
33.         Dim As String MCIError
34.         MCIError = Space$(255)
35.         x = mciGetErrorString(a, MCIError, Len(MCIError))
36.         Print MCIError
37.         End
38.     Else
39.         a = mciSendString("set capture time format ms bitspersample 16 channels 2 samplespersec 48000 bytespersec 192000 alignment 4" + Chr$(0), "", 0, 0)
40.         a = mciSendString("record capture" + Chr$(0), "", 0, 0)
41.     End If
42. End Sub
43.  
44. Sub StopRecording
45.     Dim As Long a
46.     a = mciSendString("stop capture" + Chr$(0), "", 0, 0)
47. End Sub
48.  
49. Sub SaveRecording (file As String)
50.     Dim a As Long
51.     a = mciSendString("save capture " + Chr$(34) + file + Chr$(34) + Chr$(0), "", 0, 0)
52.     a = mciSendString("close capture" + Chr$(0), "", 0, 0)
53. End Sub
54.  
55. Sub ShowWaveForm (file As String)
56.     Const true = -1, false = 0
57.  
58.     Dim theSound As Long, x0 As Long, i As _Offset, j As _Offset
59.     Dim a%, c~&, k&, trackerHeight As Integer
60.     Dim y0 As Long, y1 As Long
61.     Dim mouseDown As _Byte, f$, mouseDownOn As Integer
62.     Dim sleft As _MEM, sright As _MEM
63.     Dim stereo As _Byte
64.     Dim stereoScreen As Long, monoScreen As Long
65.  
66.     stereoScreen = _NewImage(882, 400, 32)
67.     monoScreen = _NewImage(882, 200, 32)
68.     Screen monoScreen
69.  
70.  
71.     f$ = file
72.  
73.     Print "Loading '"; f$; "'..."
74.     theSound = _SndOpen(f$)
75.     If theSound = 0 Then Print "Load failed.": End
76.  
77.     loaded:
78.     sleft = _MemSound(theSound, 1)
79.     sright = _MemSound(theSound, 2)
80.  
81.     If sright.SIZE > 0 Then
82.         Screen stereoScreen
83.         stereo = true
84.         y0 = _Height / 4
85.         y1 = _Height - _Height / 4
86.     Else
87.         Screen monoScreen
88.         stereo = false
89.         y0 = _Height / 2
90.     End If
91.     _PrintMode _KeepBackground
92.  
93.     trackerHeight = 50
94.     _SndPlay theSound
95.     _SndPause theSound
96.  
97.     Do
98.         While _MouseInput: Wend
99.         If _MouseButton(1) Then
100.             If mouseDown = false Then
101.                 mouseDown = true
102.                 If _MouseY < _Height - trackerHeight Then
103.                     mouseDownOn = 1 'plot area
104.                 Else
105.                     mouseDownOn = 2 'track area
106.                 End If
107.             Else
108.                 If mouseDownOn = 2 And _SndPlaying(theSound) = 0 Then
109.                     _SndSetPos theSound, map(_MouseX, 0, _Width, 0, _SndLen(theSound))
110.                 End If
111.             End If
112.         Else
113.             If mouseDown Then
114.                 'toggle play
115.                 If mouseDownOn = 1 Then
116.                     toggleSoundState theSound
117.                 ElseIf mouseDownOn = 2 Then
118.                     _SndSetPos theSound, map(_MouseX, 0, _Width, 0, _SndLen(theSound))
119.                 End If
120.                 mouseDown = false
121.                 mouseDownOn = 0
122.             End If
123.         End If
124.  
125.         k& = _KeyHit
126.         If k& = 32 Then toggleSoundState theSound
127.  
128.         If _TotalDroppedFiles > 0 Then
129.             If _FileExists(_DroppedFile$(1)) Then
130.                 _SndStop theSound
131.                 _SndClose theSound
132.                 theSound = 0
133.                 f$ = _DroppedFile$(1)
134.                 _PrintString (_Width / 2 - _PrintWidth("Loading...") / 2, _Height / 2 - _FontHeight), "Loading..."
135.                 _Display
136.                 theSound = _SndOpen(f$)
137.                 If theSound Then
138.                     _FinishDrop
139.                     GoTo loaded
140.                 Else
141.                     Print "Load failed."
142.                     End
143.                 End If
144.             End If
145.             _FinishDrop
146.         End If
147.  
148.         Dim alpha As Integer
149.         alpha = 50 'IF _SNDPLAYING(theSound) THEN alpha = 40 ELSE alpha = 20
150.         Line (0, 0)-(_Width - 1, _Height - 1), _RGB32(0, alpha), BF
151.         GoSub render
152.         If _SndPlaying(theSound) = 0 Then _PrintString (_Width / 2 - 16, _Height / 2 - _FontHeight), Chr$(221) + Chr$(222)
153.  
154.         _Display
155.         _Limit 60
156.     Loop
157.  
158.     render:
159.     Dim o As _Offset
160.     o = Int((_SndGetPos(theSound)) * _SndRate)
161.     While o Mod 2 <> 0: o = o + 1: Wend
162.     i = sleft.OFFSET + o
163.     If stereo Then j = sright.OFFSET + o
164.     For x0 = 0 To _Width
165.         _MemGet sleft, i, a%
166.         If a% < 0 Then
167.             c~& = _RGB32(67, 150, 33, map(a%, 0, -32767, 80, 255))
168.         Else
169.             c~& = _RGB32(67, 150, 33, map(a%, 0, 32767, 80, 255))
170.         End If
171.         Line (x0, y0)-Step(0, map(a%, -32768, 32767, -_Height / 4, _Height / 4)), c~&, BF
172.  
173.         If stereo Then
174.             _MemGet sright, j, a%
175.             If a% < 0 Then
176.                 c~& = _RGB32(67, 150, 33, map(a%, 0, -32767, 80, 255))
177.             Else
178.                 c~& = _RGB32(67, 150, 33, map(a%, 0, 32767, 80, 255))
179.             End If
180.             Line (x0, y1)-Step(0, map(a%, -32768, 32767, -_Height / 4, _Height / 4)), c~&, BF
181.         End If
182.  
183.         i = i + 2
184.         If stereo Then j = j + 2
185.         If i + 2 >= sleft.OFFSET + sleft.SIZE Then Exit For
186.     Next
187.  
188.     'tracker:
189.     Line (0, _Height - trackerHeight / 3)-Step(map(_SndGetPos(theSound), 0, _SndLen(theSound), 0, _Width), -trackerHeight / 3), _RGB32(255, 180), BF
190.     If _MouseY > _Height - trackerHeight Then
191.         Line (0, _Height - trackerHeight)-Step(_Width, trackerHeight), _RGB32(255, 30), BF
192.     End If
193.  
194.     Return
195. End Sub
196.  
197. Function map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
198.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
199. End Function
200.  
201. Sub toggleSoundState (theSound As Long)
202.     If _SndPlaying(theSound) Then
203.         _SndPause theSound
204.     Else
205.         Dim i As Integer
206.         For i = -20 To 20
207.             Line (_Width / 2 + 20, _Height / 2 - 5)-Step(-40, i)
208.         Next
209.         _SndLoop theSound
210.     End If
211. End Sub

Title: Re: Sound Recorder with additional tracks?
Post by: Dav on June 10, 2021, 01:56:38 pm

Nice snippet, @SpriggsySpriggs.  Just hit me running that, wow a multi-track recorder app CAN be made in QB64.

- Dav 

Text Only | Text with Attachments