Recording audio

User projects written in or related to FreeBASIC.
VANYA
Posts: 1374
Joined: Oct 24, 2010 15:16
Location: Ярославль
Contact:

Recording audio

Postby VANYA » Jun 17, 2012 4:38

Image

This program certainly could write a simple high-level functions using mciSendString, but we are not looking for ways to light :)
It is simple to program features, which can record single-channel audio from an audio device with a pre 11 000 Hz sampling rate and the maximum possible recording time 2 hours. Of course, these values ​​may change in the code. Also, the program plays the recorded audio and optionally saved to disk in a format WAV.

Platform: Windows

Code: Select all

#Include "windows.bi"
#Include "win/mmsystem.bi"

Const As Integer Lenght = 7200 ' maximum 2 hours

Type WaveFileHeader
   riff(3) As Byte = {82,73,70,70}
   Len_ As  Integer
   cWavFmt(7) As Byte = {87,65,86,69,102,109,116,32}
   dwHdrLen As Integer = 16
   wFormat As Short = 1
   wNumChannels As Short = 1
   dwSampleRate As Integer = 11000
   dwBytesPerSec As Integer = 22000
   wBlockAlign As Short = 4
   wBitsPerSample As Short = 16
   cData(3) As Byte = {100,97,116,97}
   dwDataLen As Integer
End Type

Type Sound
   As HWND hw
   As HWND StaticTime,ButtonRec,ButtonPlay,ButtonSave
   As WAVEHDR hdr
   As HWAVEIN hWaveIn
   As HWAVEOUT hWaveOut
   As WAVEFORMATEX wfx
   As WaveFileHeader Wavehdr
   As Byte buffer(11000*Lenght*2)
   As MSG msg
   As WNDCLASSEX wc
   As String NameClass="MyClass"
   As HINSTANCE Hinst=GetModuleHandle(0)
   As Double Tsec,SaveRecTime
   As BOOL Frec,Fplay,playtrue
   Declare Function init() As BOOL
   Declare Function Rec() As BOOL
   Declare Sub RecStop()
   Declare Function Play() As BOOL
   Declare Sub PlayStop()
   Declare Sub SaveSound()
   Declare Static Function wndproc(hwnd As HWND, msg As UInteger,_
   wparam As WPARAM, lparam As LPARAM) As Integer
End Type

Dim Shared obj As Sound
obj.init

Function Sound.init() As BOOL
   With wc
      .cbSize=SizeOf(WNDCLASSEX)
      .style=CS_HREDRAW Or CS_VREDRAW
      .lpfnWndProc=@WndProc
      .hInstance=Hinst
      .hIcon=LoadIcon(0,IDI_WINLOGO)
      .hCursor=LoadCursor(0,IDC_ARROW)
      .hbrBackground=Cast(HBRUSH,COLOR_WINDOWFRAME)
      .lpszClassName=StrPtr(NameClass)
      .hIconSm=.hIcon
   End With
   If RegisterClassEx(@wc)=0 Then
      Print "Register error, press any key"
      Sleep
      End
   EndIf
   hw=CreateWindowEx(0,NameClass,"Simple Recorder",_
   WS_VISIBLE Or WS_OVERLAPPEDWINDOW,100,100,235,110,0,0,Hinst,0)
   SetTimer(hw,1,1000,0)
   ' Цикл сообщений
   While GetMessage(@msg,0,0,0)
      TranslateMessage(@msg)
      DispatchMessage(@msg)
   Wend
   Return TRUE
End Function

Sub Sound.SaveSound()
   Var Hfile=CreateFile("SoundTest.wav",GENERIC_WRITE Or GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL,0)
   Dim buff As Integer
   WriteFile(Hfile,Cast(LPCVOID,@Wavehdr),SizeOf(WaveFileHeader),@buff,0)
   WriteFile(Hfile,Cast(LPCVOID,@buffer(0)),Wavehdr.dwDataLen,@buff,0)
   CloseHandle(Hfile)
End Sub

Function Sound.Rec() As BOOL
   ZeroMemory(@buffer(0),UBound(buffer)+1)
   With wfx
      .wFormatTag = WAVE_FORMAT_PCM
      .nChannels = 1
      .nSamplesPerSec = 11000
      .wBitsPerSample = 16
      .nBlockAlign = .nChannels * (.wBitsPerSample \ 8)
      .nAvgBytesPerSec = .nSamplesPerSec * .nBlockAlign
      .cbSize = SizeOf(WAVEFORMATEX)
   End With
   With hdr
      .lpData = @buffer(0)
      .dwBufferLength = UBound(buffer)+1
   End With
   If waveInOpen(@hWaveIn, Cast(UInteger, -1), @wfx, 0, 0, CALLBACK_NULL)<> MMSYSERR_NOERROR Then
      MessageBox(0,"Unable to mount device","Error",0)
      Return FALSE
   EndIf
   waveInPrepareHeader(hWaveIn, @hdr, SizeOf(WAVEHDR))
   waveInAddBuffer(hWaveIn, @hdr, SizeOf(WAVEHDR))

   If waveInStart(hWaveIn)<> MMSYSERR_NOERROR Then
      MessageBox(0,"A bad start recording","Error",0)
      Return FALSE
   EndIf
   Return TRUE
End Function

Sub Sound.RecStop()
   waveInReset(hWaveIn)
   waveInUnprepareHeader(hWaveIn, @hdr, SizeOf(WAVEHDR))
   waveInClose(hWaveIn)
End Sub

Function Sound.Play() As BOOL
   If waveOutOpen(@hWaveOut, Cast(UInteger, -1), @wfx, 0, 0, CALLBACK_NULL)<> MMSYSERR_NOERROR Then
      MessageBox(0,"Unable to mount device","Error",0)
      Return FALSE
   EndIf
   waveOutPrepareHeader(hWaveOut, @hdr, SizeOf(WAVEHDR))
   waveOutWrite(hWaveOut, @hdr, SizeOf(WAVEHDR))
   Return TRUE
End Function

Sub Sound.PlayStop()
   waveOutReset(hWaveOut)
   waveOutUnprepareHeader(hWaveOut, @hdr, SizeOf(WAVEHDR))
   waveOutClose(hWaveOut)
End Sub

Function Sound.wndproc(hwnd As HWND, msg As UInteger,_
   wparam As WPARAM, lparam As LPARAM) As Integer
   Select Case msg
      Case WM_CREATE
         obj.ButtonRec  = CreateWindowEx(0,"button","Record",WS_CHILD Or WS_VISIBLE,10,10,60,20,hwnd,Cast(HMENU,1),0,0)
         obj.StaticTime = CreateWindowEx(0,"Static","0:00",WS_CHILD Or WS_VISIBLE Or SS_CENTER Or SS_CENTERIMAGE,80,10,60,20,hwnd,Cast(HMENU,2),0,0)
         obj.ButtonPlay = CreateWindowEx(0,"button","Play",WS_CHILD Or WS_VISIBLE,150,10,60,20,hwnd,Cast(HMENU,3),0,0)
         obj.ButtonSave = CreateWindowEx(0,"button","Save",WS_CHILD Or WS_VISIBLE,70,40,80,20,hwnd,Cast(HMENU,4),0,0)
      Case WM_TIMER
         If obj.Frec = 1 Or obj.Fplay = 1 Then
            Dim As Integer m = (Timer()- obj.Tsec)\60,s = (Timer()- obj.Tsec) Mod 60
            If obj.SaveRecTime<=Timer()- obj.Tsec And obj.Fplay = 1 Then
               SendMessage(hwnd,WM_COMMAND,Makelparam(3,0),0)
            EndIf
            If s<10 Then
               SetWindowText(obj.StaticTime,m & ":" & "0" & s)
            Else
               SetWindowText(obj.StaticTime,m & ":"  & s)
            EndIf
         EndIf
      Case WM_COMMAND
         Select Case LoWord(WPARAM)
            Case 1
               If obj.Frec = 0 Then
                  obj.Frec = 1
                  SetWindowText(obj.ButtonRec,"Stop")                  
                  obj.Tsec = Timer()
                  EnableWindow(obj.ButtonPlay,FALSE)
                  EnableWindow(obj.ButtonSave,FALSE)
                  obj.rec()
               Else
                  obj.Frec = 0
                  SetWindowText(obj.ButtonRec,"Record")               
                  obj.Tsec = Timer()- obj.Tsec
                  obj.RecStop()
                  obj.SaveRecTime = obj.Tsec
                  EnableWindow(obj.ButtonPlay,TRUE)
                  EnableWindow(obj.ButtonSave,TRUE)
                  obj.Wavehdr.dwDataLen = 11000*obj.Tsec*2
               EndIf
               obj.playtrue= TRUE
            Case 3
               If obj.playtrue= TRUE Then                  
                  If obj.Fplay = 0 Then
                     obj.Fplay = 1
                     SetWindowText(obj.ButtonPlay,"Stop")
                     obj.Play()
                     EnableWindow(obj.ButtonRec,FALSE)
                     EnableWindow(obj.ButtonSave,FALSE)
                     obj.Tsec = Timer()
                  Else
                     obj.Fplay = 0
                     SetWindowText(obj.ButtonPlay,"Play")
                     obj.PlayStop()
                     EnableWindow(obj.ButtonRec,TRUE)
                     EnableWindow(obj.ButtonSave,TRUE)
                  EndIf
               EndIf
            Case 4
               obj.SaveSound()
               MessageBox(0,"SoundTest.wav file saved in a folder with the program","",0)
         End Select
      Case WM_DESTROY
         PostQuitMessage(0)
   End Select
   Return DefWindowProc(hwnd,msg,wparam,lparam)
End Function

BasicCoder2
Posts: 3586
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Recording audio

Postby BasicCoder2 » Jun 17, 2012 5:41

Worked for me but I don't understand how it works or how I could use it in my own programs?

I assume obj.init creates a Sound object which is the little window and its buttons?

It would be neat to just write something like this:

Code: Select all

dim as soundObject mySound

record(mySound)
play(mySound)
save(mySound,"C:/mySounds")
load(mySound,"C:/mySounds")
VANYA
Posts: 1374
Joined: Oct 24, 2010 15:16
Location: Ярославль
Contact:

Re: Recording audio

Postby VANYA » Jun 17, 2012 6:17

BasicCoder2 wrote:Worked for me but I don't understand how it works or how I could use it in my own programs?

I assume obj.init creates a Sound object which is the little window and its buttons?

It would be neat to just write something like this:

Code: Select all

dim as soundObject mySound

record(mySound)
play(mySound)
save(mySound,"C:/mySounds")
load(mySound,"C:/mySounds")


Hi BasicCoder2!

I put the finished project. If it was a preparation for a program, I would have posted here.

The code is no big deal if you want to use for their programs, eliminate all the terms of GUI:

Code: Select all

#Include "windows.bi"
#Include "win/mmsystem.bi"

Const As Integer Lenght = 7200 ' maximum 2 hours

Type WaveFileHeader
   riff(3) As Byte = {82,73,70,70}
   Len_ As  Integer
   cWavFmt(7) As Byte = {87,65,86,69,102,109,116,32}
   dwHdrLen As Integer = 16
   wFormat As Short = 1
   wNumChannels As Short = 1
   dwSampleRate As Integer = 11000
   dwBytesPerSec As Integer = 22000
   wBlockAlign As Short = 4
   wBitsPerSample As Short = 16
   cData(3) As Byte = {100,97,116,97}
   dwDataLen As Integer
End Type

Type Sound
   As WAVEHDR hdr
   As HWAVEIN hWaveIn
   As HWAVEOUT hWaveOut
   As WAVEFORMATEX wfx
   As WaveFileHeader Wavehdr
   As Byte buffer(11000*Lenght*2)
   Declare Function Rec() As BOOL
   Declare Sub RecStop()
   Declare Function Play() As BOOL
   Declare Sub PlayStop()
   Declare Sub SaveSound()
End Type

Dim Shared obj As Sound

Sub Sound.SaveSound()
   Var Hfile=CreateFile("SoundTest.wav",GENERIC_WRITE Or GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL,0)
   Dim buff As Integer
   WriteFile(Hfile,Cast(LPCVOID,@Wavehdr),SizeOf(WaveFileHeader),@buff,0)
   WriteFile(Hfile,Cast(LPCVOID,@buffer(0)),Wavehdr.dwDataLen,@buff,0)
   CloseHandle(Hfile)
End Sub

Function Sound.Rec() As BOOL
   ZeroMemory(@buffer(0),UBound(buffer)+1)
   With wfx
      .wFormatTag = WAVE_FORMAT_PCM
      .nChannels = 1
      .nSamplesPerSec = 11000
      .wBitsPerSample = 16
      .nBlockAlign = .nChannels * (.wBitsPerSample \ 8)
      .nAvgBytesPerSec = .nSamplesPerSec * .nBlockAlign
      .cbSize = SizeOf(WAVEFORMATEX)
   End With
   With hdr
      .lpData = @buffer(0)
      .dwBufferLength = UBound(buffer)+1
   End With
   If waveInOpen(@hWaveIn, Cast(UInteger, -1), @wfx, 0, 0, CALLBACK_NULL)<> MMSYSERR_NOERROR Then
      MessageBox(0,"Unable to mount device","Error",0)
      Return FALSE
   EndIf
   waveInPrepareHeader(hWaveIn, @hdr, SizeOf(WAVEHDR))
   waveInAddBuffer(hWaveIn, @hdr, SizeOf(WAVEHDR))

   If waveInStart(hWaveIn)<> MMSYSERR_NOERROR Then
      MessageBox(0,"A bad start recording","Error",0)
      Return FALSE
   EndIf
   Return TRUE
End Function

Sub Sound.RecStop()
   waveInReset(hWaveIn)
   waveInUnprepareHeader(hWaveIn, @hdr, SizeOf(WAVEHDR))
   waveInClose(hWaveIn)
End Sub

Function Sound.Play() As BOOL
   If waveOutOpen(@hWaveOut, Cast(UInteger, -1), @wfx, 0, 0, CALLBACK_NULL)<> MMSYSERR_NOERROR Then
      MessageBox(0,"Unable to mount device","Error",0)
      Return FALSE
   EndIf
   waveOutPrepareHeader(hWaveOut, @hdr, SizeOf(WAVEHDR))
   waveOutWrite(hWaveOut, @hdr, SizeOf(WAVEHDR))
   Return TRUE
End Function

Sub Sound.PlayStop()
   waveOutReset(hWaveOut)
   waveOutUnprepareHeader(hWaveOut, @hdr, SizeOf(WAVEHDR))
   waveOutClose(hWaveOut)
End Sub

BasicCoder2
Posts: 3586
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Recording audio

Postby BasicCoder2 » Jun 17, 2012 6:40

Are you able to give me an example as the code is kind of beyond my knowledge to use?

When I tried the code below I just got errors which I didn't understand.
C:\FreeBasic\Audio\Record2.bas(99) error 182: Member isn't static, before ')' in 'test = Sound.Rec()'
etc.

Code: Select all

dim as BOOL test
print "Hit key to start recording"
test = Sound.Rec()
print "Hit key to stop recording"
sleep
Sound.RecStop()
Sound.SaveSound()
sleep
print "Hit key to start playing"
test = Sound.Play()
sleep
print "Hit key to stop playing"
Sound.PlayStop()

sleep
end
VANYA
Posts: 1374
Joined: Oct 24, 2010 15:16
Location: Ярославль
Contact:

Re: Recording audio

Postby VANYA » Jun 17, 2012 6:57

BasicCoder2 wrote:Are you able to give me an example as the code is kind of beyond my knowledge to use?

When I tried the code below I just got errors which I didn't understand.
C:\FreeBasic\Audio\Record2.bas(99) error 182: Member isn't static, before ')' in 'test = Sound.Rec()'
etc.

Code: Select all

dim as BOOL test
print "Hit key to start recording"
test = Sound.Rec()
print "Hit key to stop recording"
sleep
Sound.RecStop()
Sound.SaveSound()
sleep
print "Hit key to start playing"
test = Sound.Play()
sleep
print "Hit key to stop playing"
Sound.PlayStop()

sleep
end



Code: Select all

' ************************* main ***************************
Dim Shared obj As Sound '<- create object

dim as BOOL test

test = obj.Rec() '<- rec
Var Tsec = Timer() '<- Begin Calculate Recording times
Print "Hit key to stop recording"
Sleep
Tsec = Timer()- Tsec '<- End Calculate Recording times (Result)
obj.RecStop()
obj.Wavehdr.dwDataLen = 11000*Tsec*2 '<- Write the length of the buffer
obj.SaveSound() '<- SAVE in WAV
sleep
Print "Hit key to start playing"
test = obj.Play() '<- Play
sleep
Print "Hit key to stop playing"
obj.PlayStop()
sleep
End
BasicCoder2
Posts: 3586
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Recording audio

Postby BasicCoder2 » Jun 17, 2012 7:45

Can you put the recording in a loop so it is background to a game?

What happens between the ending of the sound file and the obj.PlayStop() ?
Does it just stop by itself?
Is obj.PlayStop() required?

This is my version:

Code: Select all

' ************************* main ***************************
screenres 640,480,32

Dim Shared obj As Sound '<- create object

dim as BOOL test
print "hit key to start recording"
sleep
test = obj.Rec() '<- rec
Var Tsec = Timer() '<- Begin Calculate Recording times
Print "Hit key to stop recording"
Sleep
Tsec = Timer()- Tsec '<- End Calculate Recording times (Result)
obj.RecStop()
obj.Wavehdr.dwDataLen = 11000*Tsec*2 '<- Write the length of the buffer
obj.SaveSound() '<- SAVE in WAV
Print "Hit key to start playing"
sleep

test = obj.Play() '<- Play

'  #####   while playing back other things can take place #####

Print "Hit ESC key to stop playing"
dim as integer x,y
do
    x = int(rnd(1)*640)
    y = int(rnd(1)*480)
    circle(x,y),int(rnd(1)*10)+5,rgb(int(rnd(1)*256),int(rnd(1)*256),int(rnd(1)*256))
    sleep 10
loop until multikey(&H01)

obj.PlayStop()

sleep
End
VANYA
Posts: 1374
Joined: Oct 24, 2010 15:16
Location: Ярославль
Contact:

Re: Recording audio

Postby VANYA » Jun 17, 2012 8:21

BasicCoder2 wrote:
What happens between the ending of the sound file and the obj.PlayStop() ?
Does it just stop by itself?
Is obj.PlayStop() required?



This is a simplified version without the callback function. In this version you do have to keep track of time playing! Time is saved in the variable Tsec

For your example, to play the file should be: Tsec / 10 , (Sleep 10). But there should be nothing wrong if you are late to call the function PlayStop.

If you find it difficult to understand in this example, you can use a high-level function MciSendString:

http://freebasic-world.narod.ru/mcisendstring.html


just for playing, you can use SndPlaySound:

Code: Select all

#include once "windows.bi"
#include once "win/mmsystem.bi"
for x as integer = 1 to 3
 sndPlaySound( "ringout.wav", SND_SYNC )
 sleep 1000
next x
Sleep
12val12newakk
Posts: 20
Joined: Nov 14, 2019 17:04

Re: Recording audio

Postby 12val12newakk » Aug 12, 2020 14:00

How to get rid of the unnecessary from this code
(get rid of * .wav)?
Just after the event, write 10 seconds of sound to the array
1 channel 16 bit

Return to “Projects”

Who is online

Users browsing this forum: No registered users and 8 guests