Воспроизведение WAV (Linux [32-bit, 64-bit],Windows [32-bit, 64-bit])
Очень часто в своих проектах я нуждался в функциональности, связанной с воспроизведением звука. Конечно же есть различные библиотеки. Однако у чужих библиотек есть свои минусы. Например требование дополнительного лицензирования, установка дополнительного ПО , а часто просто немалое время на изучение интерфейса и даже настройка\правка\перекомпилирование. В большинстве случаев мне хватало проигрывания простых файлов в формате WAV. Если брать систему Windows , то тут не возникало абсолютно никаких проблем, поскольку программных возможностей системы (как простых , так более сложных) хватает с избытком, чего конечно не скажешь про систему Linux. В системе Linux часто не заморачиваются, а просто прибегают к помощи сторонних библиотек (FMOD, BASS, OPENAL и пр.), либо используют консольные возможности встроенных программ, вроде aplay. Поначалу я обрадовался, когда нашел код пользователя с ником angros47 , но как оказалось данный код под Linux проигрывает WAV только небольших размеров (упирается в буфер звуковой карты). Я решил сам реализовать воспроизведение звука , опираясь на опыт других исходных кодов, а так же читая документацию ALSA. Насколько хорошо это у меня получилось, судить вам! Я тестировал на системах Linux Mint 32-bit, Linux Mint 64-bit, windows 7 32-bit, Windows 10 64-bit (с компиляторами 32-bit и 64-bit) . На Linux и Windows у меня проигрываются форматы: PCM 16-LE, PCM IEEE FLOATING-POINT, а большего мне и не нужно :)
Вы можете использовать исходные коды с этой страницы как вам заблагорассудится без всяких ограничений!
Интерфейс использования под Linux и Windows одинаковый. Можно проигрывать одновременно несколько файлов (примечание: в Linux для этого должна быть правильно сконфигурирована система. На Linux Mint все сконфигурировано по умолчанию). Для компиляции в Linux должна быть установлена низкоуровневая библиотека ALSA для разработчиков libasound-dev или libasound2-dev . Ее всегда можно установить из менеджера программ, либо вручную: sudo apt-get install libasound-dev или sudo apt-get install libasound2-dev.
Описание функций:
LoadWav - загрузка WAV файла в буфер из файла
PlayWav - воспроизведение звука. При повторном вызове, во время проигрывания текущего буфера, воспроизведение начинает сначала.
PauseWav - пауза при воспроизведении. При повторном вызове, начинает проигрывание с текущего места
StopWav - останавливает воспроизведение и сбрасывает на начало проигрывание.
FreeWav - останавливает воспроизведение (если не остановлено) и освобождает все ресурсы, связанные со звуком.
StatusPlay - возвращает статус воспроизведения (0-не проигрывается, 1- проигрывается, 2-пауза)
GetLengthSeconds - возвращает длительность трека в секундах.
Файлы для Linux:
alsa.bi
Dim Shared As Any Ptr alsa 'ALSA declarations alsa = Dylibload("asound") Const EAGAIN = -11 ' Try again Const EPIPE = -32 ' Broken pipe Const ESTRPIPE = -86 ' Streams pipe error Const EIO = -5 ' I/O error Const EBADFD = -77 ' File descriptor in bad state Const BLOCK = 0 Const NONBLOCK = 1 Const ASYNC = 2 Const SND_PCM_STREAM_PLAYBACK = 0 Const SND_PCM_STREAM_CAPTURE = 1 Const SND_PCM_ACCESS_RW_INTERLEAVED= 3 Enum snd_pcm_format_t SND_PCM_FORMAT_UNKNOWN = -1 SND_PCM_FORMAT_S8 = 0 SND_PCM_FORMAT_U8 SND_PCM_FORMAT_S16_LE SND_PCM_FORMAT_S16_BE SND_PCM_FORMAT_U16_LE SND_PCM_FORMAT_U16_BE SND_PCM_FORMAT_S24_LE SND_PCM_FORMAT_S24_BE SND_PCM_FORMAT_U24_LE SND_PCM_FORMAT_U24_BE SND_PCM_FORMAT_S32_LE SND_PCM_FORMAT_S32_BE SND_PCM_FORMAT_U32_LE SND_PCM_FORMAT_U32_BE SND_PCM_FORMAT_FLOAT_LE SND_PCM_FORMAT_FLOAT_BE SND_PCM_FORMAT_FLOAT64_LE SND_PCM_FORMAT_FLOAT64_BE SND_PCM_FORMAT_IEC958_SUBFRAME_LE SND_PCM_FORMAT_IEC958_SUBFRAME_BE SND_PCM_FORMAT_MU_LAW, SND_PCM_FORMAT_A_LAW SND_PCM_FORMAT_IMA_ADPCM SND_PCM_FORMAT_MPEG SND_PCM_FORMAT_GSM SND_PCM_FORMAT_SPECIAL = 31 SND_PCM_FORMAT_S24_3LE = 32 SND_PCM_FORMAT_S24_3BE SND_PCM_FORMAT_U24_3LE SND_PCM_FORMAT_U24_3BE SND_PCM_FORMAT_S20_3LE SND_PCM_FORMAT_S20_3BE SND_PCM_FORMAT_U20_3LE SND_PCM_FORMAT_U20_3BE SND_PCM_FORMAT_S18_3LE SND_PCM_FORMAT_S18_3BE SND_PCM_FORMAT_U18_3LE SND_PCM_FORMAT_U18_3BE SND_PCM_FORMAT_G723_24 SND_PCM_FORMAT_G723_24_1B SND_PCM_FORMAT_G723_40 SND_PCM_FORMAT_G723_40_1B SND_PCM_FORMAT_DSD_U8 SND_PCM_FORMAT_DSD_U16_LE SND_PCM_FORMAT_DSD_U32_LE SND_PCM_FORMAT_DSD_U16_BE SND_PCM_FORMAT_DSD_U32_BE SND_PCM_FORMAT_LAST = SND_PCM_FORMAT_DSD_U32_BE SND_PCM_FORMAT_S16 = SND_PCM_FORMAT_S16_LE SND_PCM_FORMAT_U16 = SND_PCM_FORMAT_U16_LE SND_PCM_FORMAT_S24 = SND_PCM_FORMAT_S24_LE SND_PCM_FORMAT_U24 = SND_PCM_FORMAT_U24_LE SND_PCM_FORMAT_S32 = SND_PCM_FORMAT_S32_LE SND_PCM_FORMAT_U32 = SND_PCM_FORMAT_U32_LE SND_PCM_FORMAT_FLOAT = SND_PCM_FORMAT_FLOAT_LE SND_PCM_FORMAT_FLOAT64 = SND_PCM_FORMAT_FLOAT64_LE SND_PCM_FORMAT_IEC958_SUBFRAME = SND_PCM_FORMAT_IEC958_SUBFRAME_LE End Enum #IFNDEF NULL #DEFINE NULL 0 #ENDIF Type snd_pcm_t As Any Ptr Type snd_pcm_hw_params_t As Any Ptr Type snd_output_t As Any Ptr ' PCM Dim Shared snd_strerror As Function ( _ Byval ecode As Long) As Zstring Ptr snd_strerror= Dylibsymbol(alsa, "snd_strerror") Dim Shared snd_pcm_open As Function ( _ Byval pcm As snd_pcm_t Ptr, _ Byval device As Zstring Ptr, _ Byval direction As Long, _ Byval mode As Long) As Long snd_pcm_open= Dylibsymbol(alsa, "snd_pcm_open") Dim Shared snd_pcm_close As Function ( _ Byval pcm As snd_pcm_t) As Long snd_pcm_close= Dylibsymbol(alsa, "snd_pcm_close") Dim Shared snd_pcm_start As Function ( _ Byval pcm As snd_pcm_t) As Long snd_pcm_start= Dylibsymbol(alsa, "snd_pcm_start") Dim Shared snd_pcm_drain As Function ( _ Byval pcm As snd_pcm_t) As Long snd_pcm_drain= Dylibsymbol(alsa, "snd_pcm_drain") Dim Shared snd_pcm_hw_free As Function ( _ Byval pcm As snd_pcm_t) As Long snd_pcm_hw_free= Dylibsymbol(alsa, "snd_pcm_hw_free") Dim Shared snd_pcm_nonblock As Function ( _ Byval pcm As snd_pcm_t, _ Byval nonblock As Long) As Long snd_pcm_nonblock= Dylibsymbol(alsa, "snd_pcm_nonblock") Dim Shared snd_pcm_prepare As Function ( _ Byval pcm As snd_pcm_t) As Long snd_pcm_prepare= Dylibsymbol(alsa, "snd_pcm_prepare") Dim Shared snd_pcm_writei As Function ( _ Byval pcm As snd_pcm_t, _ Byval buffer As Any Ptr, _ Byval size As Long) As Long snd_pcm_writei= Dylibsymbol(alsa, "snd_pcm_writei") Dim Shared snd_pcm_recover As Function ( _ Byval pcm As snd_pcm_t, _ Byval Err As Long, _ Byval silent As Long) As Long snd_pcm_recover= Dylibsymbol(alsa, "snd_pcm_recover") Dim Shared snd_pcm_avail_update As Function ( _ Byval pcm As snd_pcm_t) As Long snd_pcm_avail_update= Dylibsymbol(alsa, "snd_pcm_avail_update") Dim Shared snd_pcm_delay As Function ( _ Byval pcm As snd_pcm_t, _ Byval delayp As snd_pcm_t) As Long snd_pcm_delay= Dylibsymbol(alsa, "snd_pcm_delay") Dim Shared snd_pcm_wait As Function ( _ Byval pcm As snd_pcm_t, _ Byval msec As Long) As Long snd_pcm_wait= Dylibsymbol(alsa, "snd_pcm_wait") Dim Shared snd_pcm_resume As Function ( _ Byval pcm As snd_pcm_t) As Long snd_pcm_resume= Dylibsymbol(alsa, "snd_pcm_resume") 'hardware Dim Shared snd_pcm_hw_params_malloc As Function ( _ Byval hw As snd_pcm_hw_params_t Ptr) As Long snd_pcm_hw_params_malloc= Dylibsymbol(alsa, "snd_pcm_hw_params_malloc") Dim Shared snd_pcm_hw_params_any As Function ( _ Byval pcm As snd_pcm_t, _ Byval hw As snd_pcm_hw_params_t) As Long snd_pcm_hw_params_any= Dylibsymbol(alsa, "snd_pcm_hw_params_any") Dim Shared snd_pcm_hw_params_set_access As Function ( _ Byval pcm As snd_pcm_t, _ Byval hw As snd_pcm_hw_params_t, _ Byval mode As Long) As Long snd_pcm_hw_params_set_access= Dylibsymbol(alsa, "snd_pcm_hw_params_set_access") Dim Shared snd_pcm_hw_params_set_format As Function ( _ Byval pcm As snd_pcm_t, _ Byval hw As snd_pcm_hw_params_t, _ Byval fmt As Long) As Long snd_pcm_hw_params_set_format= Dylibsymbol(alsa, "snd_pcm_hw_params_set_format") Dim Shared snd_pcm_hw_params_set_channels As Function ( _ Byval pcm As snd_pcm_t, _ Byval hw As snd_pcm_hw_params_t, _ Byval Channels As Long) As Long snd_pcm_hw_params_set_channels= Dylibsymbol(alsa, "snd_pcm_hw_params_set_channels") Dim Shared snd_pcm_hw_params_get_channels As Function ( _ Byval hw As snd_pcm_hw_params_t, _ Byval lpChannels As Long Ptr) As Long snd_pcm_hw_params_get_channels= Dylibsymbol(alsa, "snd_pcm_hw_params_get_channels") Dim Shared snd_pcm_hw_params_set_rate_near As Function ( _ Byval pcm As snd_pcm_t, _ Byval hw As snd_pcm_hw_params_t, _ Byval lpRate As Long Ptr, _ Byval lpDir As Long Ptr) As Long snd_pcm_hw_params_set_rate_near= Dylibsymbol(alsa, "snd_pcm_hw_params_set_rate_near") Dim Shared snd_pcm_hw_params_get_periods As Function ( _ Byval hw As snd_pcm_hw_params_t, _ Byval lpValue As Long Ptr, _ Byval lpDir As Long Ptr) As Long snd_pcm_hw_params_get_periods= Dylibsymbol(alsa, "snd_pcm_hw_params_get_periods") Dim Shared snd_pcm_hw_params_set_periods_near As Function ( _ Byval pcm As snd_pcm_t, _ Byval hw As snd_pcm_hw_params_t, _ Byval lpValue As Long Ptr, _ Byval lpDir As Long Ptr) As Long snd_pcm_hw_params_set_periods_near= Dylibsymbol(alsa, "snd_pcm_hw_params_set_periods_near") Dim Shared snd_pcm_hw_params_get_period_size As Function ( _ Byval params As snd_pcm_hw_params_t, _ Byval lpFrames As Long Ptr, _ Byval lpDir As Long Ptr) As Long snd_pcm_hw_params_get_period_size= Dylibsymbol(alsa, "snd_pcm_hw_params_get_period_size") Dim Shared snd_pcm_hw_params_set_period_size_near As Function ( _ Byval pcm As snd_pcm_t Ptr, _ Byval hw As snd_pcm_hw_params_t, _ Byval lpValue As Long Ptr, _ Byval lpDir As Long Ptr) As Long snd_pcm_hw_params_set_period_size_near= Dylibsymbol(alsa, "snd_pcm_hw_params_set_period_size_near") Dim Shared snd_pcm_hw_params_set_buffer_size_near As Function ( _ Byval pcm As snd_pcm_t, _ Byval hw As snd_pcm_hw_params_t, _ Byval lpFrames As Long Ptr) As Long snd_pcm_hw_params_set_buffer_size_near= Dylibsymbol(alsa, "snd_pcm_hw_params_set_buffer_size_near") Dim Shared snd_pcm_hw_params_get_buffer_size As Function ( _ Byval hw As snd_pcm_hw_params_t, _ Byval lpFrames As Long Ptr) As Long snd_pcm_hw_params_get_buffer_size= Dylibsymbol(alsa, "snd_pcm_hw_params_get_buffer_size") Dim Shared snd_pcm_hw_params As Function ( _ Byval pcm As snd_pcm_t, _ Byval hw As snd_pcm_hw_params_t) As Long snd_pcm_hw_params= Dylibsymbol(alsa, "snd_pcm_hw_params") Dim Shared snd_pcm_hw_params_free As Sub ( _ Byval hw As snd_pcm_hw_params_t) snd_pcm_hw_params_free= Dylibsymbol(alsa, "snd_pcm_hw_params_free") Dim Shared snd_pcm_hw_params_set_period_size As Function( _ Byval pcm As snd_pcm_t , _ Byval params As snd_pcm_hw_params_t, _ Byval nFrames As Long , _ Byval pDir As Long Ptr) As Long snd_pcm_hw_params_set_period_size = Dylibsymbol(alsa, "snd_pcm_hw_params_set_period_size") Dim Shared snd_pcm_hw_params_set_buffer_size As Function( _ Byval pcm As snd_pcm_t , _ Byval hw As snd_pcm_hw_params_t, _ Byval Frames As Long) As Long snd_pcm_hw_params_set_buffer_size = Dylibsymbol(alsa, "snd_pcm_hw_params_set_buffer_size")
FBLinuxSoundWav.bas:
#INCLUDE "alsa.bi" Type FbWAV As Short shFtag As Short shCanal As Short shBits As snd_pcm_t Ptr hDevice As snd_pcm_hw_params_t Ptr hw As Long iBufferSize As Long iSampleRate As Long iByteRate As Byte Ptr bSoundBuffer As Long iPause As Long iPauseSt As Long iStop As Long iStopWav As Any Ptr Thread As Any Ptr mutexstop Declare Function LoadWav(As Zstring Ptr) As Long Declare Function Play(As FbWav Ptr) As Long Declare Static Function PlayT(As FbWav Ptr) As Long Declare Function Stop() As Long Declare Function Pause() As Long Declare Destructor() Private: Declare Function SetParam() As Long End Type Destructor FbWAV Deallocate (bSoundBuffer) End Destructor Function GetLengthSeconds(Byref obj As FbWAV Ptr) As Long Return obj->iBufferSize\obj->iByteRate End Function Function StatusPlay(Byref obj As FbWAV Ptr) As Long Dim As Long iStatusPl, iStatusPa Mutexlock(obj->mutexstop) iStatusPl = obj->iStopWav iStatusPa = obj->iPauseSt Mutexunlock(obj->mutexstop) If iStatusPl = 0 Then Return 0 Elseif iStatusPl = -1 AndAlso iStatusPa = 0 Then Return 1 Elseif iStatusPl = -1 AndAlso iStatusPa = -1 Then Return 2 Endif End Function Function FbWAV.LoadWav(szFile As Zstring Ptr) As Long If Lcase(Right (*szFile,3)) = "wav" Then Dim idFile As Long = Freefile Open *szFile For Binary As #idFile Get #idFile,21,shFtag Get #idFile,,shCanal Get #idFile,,iSampleRate Get #idFile,29,iByteRate Get #idFile,35,shBits Get #idFile,41,iBufferSize Select Case shFtag Case 1 , 3 If iBufferSize = 0 Then Print "Invalidate data!" Return 0 Endif Case Else Print "Format Unknown!" Return 0 End Select bSoundBuffer = Allocate (iBufferSize+1) If bSoundBuffer Then Get #idFile,45,*bSoundBuffer,iBufferSize Endif Close #idFile Return SetParam() Endif End Function Function FbWAV.SetParam() As Long Dim As Long iDirection , iRet If alsa Then iRet = snd_pcm_open(@hDevice, "default", SND_PCM_STREAM_PLAYBACK, BLOCK) If iRet < 0 Then Print "Error snd_pcm_open" Return 0 Endif snd_pcm_hw_params_malloc(@hw) iRet = snd_pcm_hw_params_any(hDevice, hw) If iRet < 0 Then Print "Error snd_pcm_hw_params_any" Return 0 Endif iRet = snd_pcm_hw_params_set_access(hDevice, hw, SND_PCM_ACCESS_RW_INTERLEAVED) If iRet < 0 Then Print "Error snd_pcm_hw_params_set_access" Return 0 Endif If shFtag = 1 Then If shBits = 16 Then iRet = snd_pcm_hw_params_set_format(hDevice, hw, SND_PCM_FORMAT_S16_LE) If iRet < 0 Then Print "Error snd_pcm_hw_params_set_format s16_LE" Return 0 Endif Elseif shBits = 8 Then iRet = snd_pcm_hw_params_set_format(hDevice, hw, SND_PCM_FORMAT_U8) If iRet < 0 Then Print "Error snd_pcm_hw_params_set_format u8" Return 0 Endif Endif Elseif shFtag = 3 Then iRet = snd_pcm_hw_params_set_format(hDevice, hw, SND_PCM_FORMAT_FLOAT_LE) If iRet < 0 Then Print "Error snd_pcm_hw_params_set_format FLOAT_LE" Return 0 Endif Else Print "Format Unknown!" Return 0 Endif iRet = snd_pcm_hw_params_set_channels(hDevice, hw, shCanal) If iRet < 0 Then Print "Error snd_pcm_hw_params_set_channels" Return 0 Endif iRet = snd_pcm_hw_params_set_rate_near(hDevice, hw, @iSampleRate, @iDirection) If iRet < 0 Then Print "Error snd_pcm_hw_params_set_rate_near" Return 0 Endif Dim As Long BufferSizeInFrames = 2048 iRet = snd_pcm_hw_params_set_buffer_size(hDevice, hw, BufferSizeInFrames) Dim As Long inFrames = 2048 If iRet < 0 Then iRet = snd_pcm_hw_params_set_buffer_size_near(hDevice, hw, @BufferSizeInFrames) If iRet < 0 Then Print "Error snd_pcm_hw_params_set_buffer_size_near" Return 0 Endif Endif iRet = snd_pcm_hw_params_set_period_size(hDevice, hw, inFrames, 0) If iRet < 0 Then iRet = snd_pcm_hw_params_set_period_size_near( hDevice, hw, @inFrames, 0) If iRet < 0 Then Print "Error snd_pcm_hw_params_set_period_size_near" Return 0 Endif Endif iRet = snd_pcm_hw_params(hDevice, hw) If iRet < 0 Then Print "Error snd_pcm_hw_params" Return 0 Endif snd_pcm_hw_params_free (hw) snd_pcm_prepare(hDevice) mutexstop = Mutexcreate Return -1 End If End Function Function FbWAV.Play(obj As FbWAV Ptr) As Long Dim As Long iStatusPl Mutexlock(obj->mutexstop) iStatusPl = obj->iStopWav Mutexunlock(obj->mutexstop) If iStatusPl = -1 Then obj->Stop() obj->THREAD = Threadcreate(Cast(Any Ptr,@PlayT()), Obj) Mutexlock(obj->mutexstop) obj->iStopWav = -1 Mutexunlock(obj->mutexstop) Return -1 End Function Function FbWAV.PlayT(p As FbWAV Ptr) As Long Dim As Long iRet, inErrors , inFrames , iFrameSize Dim As Any Ptr lpBuffer inFrames = 2048 iFrameSize = (p->shBits Shr 3) Shl (p->shCanal-1) lpBuffer = p->bSoundBuffer If alsa Then While (inFrames > 0) andalso (inErrors < 4) Mutexlock(p->mutexstop) If p->iStop = -1 Then Mutexunlock(p->mutexstop) Exit While Endif If p->iPause = -1 Then Sleep(1) Mutexunlock(p->mutexstop) Continue While Endif Mutexunlock(p->mutexstop) iRet = snd_pcm_writei(p->hDevice,lpBuffer,inFrames) If iRet < 0 Then Select Case iRet Case EAGAIN Sleep 1 Case EPIPE iRet = snd_pcm_prepare(p->hDevice) If (iRet < 0) Then inErrors += 1 End If Case ESTRPIPE Do iRet = snd_pcm_resume(p->hDevice) If iRet = EAGAIN Then Sleep 1 Loop While iRet = EAGAIN If (iRet < 0) Then iRet = snd_pcm_prepare(p->hDevice) If (iRet < 0) Then inErrors+=1 End If End If Case EBADFD , EIO inErrors+=1 Case Else inErrors += 1 snd_pcm_prepare(p->hDevice) End Select Else iRet *= iFrameSize lpBuffer += iRet If (lpBuffer >= p->bSoundBuffer + p->iBufferSize) Then Function = -1 Exit While Elseif (lpBuffer + iRet > p->bSoundBuffer + p->iBufferSize) Then Dim As Integer iBytes = Cast (Integer,p->bSoundBuffer + p->iBufferSize) iBytes -= Cast(Integer,lpBuffer) inFrames = Cast(Long,iBytes)\iFrameSize Function = -1 Endif End If Wend Mutexlock(p->mutexstop) p->iStopWav = 0 Mutexunlock(p->mutexstop) Endif End Function Function FbWAV.Stop() As Long Dim As Long iStatusPl Mutexlock(mutexstop) iStatusPl = iStopWav Mutexunlock(mutexstop) If iStatusPl = -1 Then Mutexlock(mutexstop) iStop = -1 Mutexunlock(mutexstop) Threadwait(THREAD) iStop = 0 iStopWav = 0 iPause = 0 iPauseSt = 0 Function = -1 Endif End Function Function FbWAV.Pause() As Long Mutexlock(mutexstop) If iStopWav = -1 Then iPause Xor= -1 iPauseSt = iPause Function = iPause Endif Mutexunlock(mutexstop) End Function Function PauseWAV(obj As FbWAV Ptr) As Long Return obj->Pause() End Function Function LoadWav(szFile As Zstring Ptr, Byref obj As FbWAV Ptr) As Long obj = New FbWAV Return obj->LoadWav(szFile) End Function Function PlayWav(obj As FbWAV Ptr) As Long Return obj->Play (obj) End Function Sub FreeWav(obj As FbWAV Ptr) Dim As Long iStatusPl Mutexlock(obj->mutexstop) iStatusPl = obj->iStopWav Mutexunlock(obj->mutexstop) If iStatusPl = -1 Then obj->Stop() Endif snd_pcm_close(obj->hDevice) Mutexdestroy(obj->mutexstop) Delete obj End Sub Sub StopWav(obj As FbWAV Ptr) obj->Stop() End Sub
Файл для Windows:
FBWindowsSoundWav.bas:
#INCLUDE "Windows.bi" #INCLUDE "win/mmsystem.bi" Type FbWAV As Short shFtag As Short shCanal As Short shBits As HWAVEOUT hWaveOut As WAVEHDR Ptr hWhdr As Long iBufferSize As Long iSampleRate As Long iByteRate As Byte Ptr bSoundBuffer As Long iPause As Long iStopWav As CRITICAL_SECTION c_s Declare Function LoadWav(As Zstring Ptr,Byref obj As FbWAV Ptr) As Long Declare Function Play() As Long Declare Function Stop() As Long Declare Function Pause() As Long Declare Static Sub SoundCallback (hwo As Any Ptr, uMsg As Ulong, dwInstance As Long, dwParam1 As Long, dwParam2 As Long ) Declare Destructor() Private: Declare Function SetParam(Byref obj As FbWAV Ptr) As Long End Type Dim Shared As FBWAV Ptr fb_info(100) Destructor FbWAV Deallocate (bSoundBuffer) End Destructor Sub FbWAV.SoundCallback (hwo As Any Ptr, uMsg As Ulong, dwInstance As Long, dwParam1 As Long, dwParam2 As Long ) If uMsg = WOM_DONE Then For i As Long = 0 To 100 If fb_info(i) <> 0 AndAlso fb_info(i)->hWaveOut = hwo Then EnterCriticalSection(@fb_info(i)->c_s) fb_info(i)->iStopWav = 0 LeaveCriticalSection(@fb_info(i)->c_s) Exit For Endif Next End If End Sub Function GetLengthSeconds(Byref obj As FbWAV Ptr) As Long Return obj->iBufferSize\obj->iByteRate End Function Function StatusPlay(Byref obj As FbWAV Ptr) As Long Dim As Long s_p EnterCriticalSection(@obj->c_s) s_p = obj->iStopWav LeaveCriticalSection(@obj->c_s) If s_p = 0 Then Return 0 Elseif s_p = -1 AndAlso obj->iPause = 0 Then Return 1 Elseif s_p = -1 AndAlso obj->iPause = -1 Then Return 2 Endif End Function Function FbWAV.LoadWav(szFile As Zstring Ptr , Byref obj As FbWAV Ptr) As Long If Lcase(Right (*szFile,3)) = "wav" Then Dim idFile As Long = Freefile Open *szFile For Binary As #idFile Get #idFile,21,shFtag Get #idFile,,shCanal Get #idFile,,iSampleRate Get #idFile,29,iByteRate Get #idFile,35,shBits Get #idFile,41,iBufferSize Select Case shFtag Case 1 , 3 If iBufferSize = 0 Then Print "Invalidate data!" Return 0 Endif Case Else Print "Format Unknown!" Return 0 End Select bSoundBuffer = Allocate (iBufferSize+1) If bSoundBuffer Then Get #idFile,45,*bSoundBuffer,iBufferSize Endif Close #idFile Return SetParam(obj) Else Return 0 Endif End Function Function FbWAV.SetParam(Byref obj As FbWAV Ptr) As Long Dim As WAVEFORMATEX wfx wfx.wFormatTag = shFtag wfx.nChannels = shCanal wfx.nSamplesPerSec = iSampleRate wfx.wBitsPerSample = shBits wfx.nBlockAlign = wfx.nChannels * wfx.wBitsPerSample / 8 wfx.nAvgBytesPerSec = wfx.nBlockAlign * wfx.nSamplesPerSec Dim As Integer scall = Cast(Integer, @SoundCallback) If waveOutOpen(@hWaveOut, WAVE_MAPPER, @wfx, scall, 0, CALLBACK_FUNCTION) <> MMSYSERR_NOERROR Then Print "Error waveOutOpen" Return NULL Else hWhdr = Allocate(Sizeof(WAVEHDR)) hWhdr->lpData = bSoundBuffer hWhdr->dwBufferLength = iBufferSize hWhdr->dwFlags = WHDR_PREPARED waveOutPrepareHeader(hWaveOut, hWhdr, Sizeof(WAVEHDR)) InitializeCriticalSection(@c_s) For i As Long = 0 To 100 If fb_info(i) = 0 Then fb_info(i) = obj Exit For Endif Next Return -1 End If End Function Function FbWAV.Play() As Long EnterCriticalSection(@c_s) If iStopWav = -1 Then LeaveCriticalSection(@c_s) Stop() Else LeaveCriticalSection(@c_s) Endif If waveOutWrite(hWaveOut, hWhdr, Sizeof(WAVEHDR)) Then waveOutUnprepareHeader(hWaveOut, hWhdr, Sizeof(WAVEHDR)) Deallocate(hWhdr) Print "Error waveOutWrite" Return 0 Else iStopWav = -1 Return -1 Endif End Function Function FbWAV.Pause() As Long EnterCriticalSection(@c_s) If iStopWav = 0 Then LeaveCriticalSection(@c_s) Exit Function Else LeaveCriticalSection(@c_s) Endif iPause Xor= -1 If iPause = 0 Then waveOutRestart(hWaveOut) Else waveOutPause(hWaveOut) Endif Return -1 End Function Function FbWAV.Stop() As Long waveOutReset(hWaveOut) iPause = 0 Return -1 End Function Function LoadWav(szFile As Zstring Ptr, Byref obj As FbWAV Ptr) As Long obj = New FbWAV Return obj->LoadWav(szFile,obj) End Function Function PlayWav(obj As FbWAV Ptr) As Long Return obj->Play () End Function Function PauseWAV(obj As FbWAV Ptr) As Long Return obj->Pause() End Function Sub FreeWav(obj As FbWAV Ptr) EnterCriticalSection(@(obj->c_s)) If obj->iStopWav = -1 Then LeaveCriticalSection(@(obj->c_s)) obj->Stop() Else LeaveCriticalSection(@(obj->c_s)) Endif waveOutClose(obj->hWaveOut) waveOutUnprepareHeader(obj->hWaveOut, obj->hWhdr, Sizeof(WAVEHDR)) For i As Long = 0 To 100 If fb_info(i) = obj Then fb_info(i) = 0 Exit For Endif Next Deallocate(obj->hWhdr) DeleteCriticalSection(@(obj->c_s)) Delete obj End Sub Sub StopWav(obj As FbWAV Ptr) obj->Stop() End Sub
Пример использования для Linux и Windows:
Подключите с помощью оператора #include:
файл FBLinuxSoundWav.bas в системе Linux
или
файл FBWindowsSoundWav.bas в системе Windows
Клавиши в примере:
клавиша "q" - выход
клавиша "Пробел" - пауза
клавиша "p" - проигрывать
клавиша "s" - стоп
Dim fb_Wav As FbWAV Ptr LoadWav("Track.wav", fb_Wav) PlayWav(fb_Wav) Do Var key = Inkey Select Case key Case " " PauseWAV(fb_Wav) Sleep(100) Case "q" Exit Do Case "s" StopWav(fb_Wav) Case "p" PlayWav(fb_Wav) End Select Var sp = StatusPlay(fb_Wav) Sleep(100) Cls If sp = 1 Then ? "Play" Elseif sp = 0 Then ? "Stop" Elseif sp = 2 Then ? "Pause" Endif ? "Length=" & GetLengthSeconds(fb_Wav) & " seconds" Loop FreeWav(fb_Wav)
P.S. клавиши "q", "p" , "s" в примере работают только в английской раскладке! Если во время работы примера у вас стоит русская раскладка, переключите на английскую, если конечно хотите использовать данные клавиши.
