Générer un son avec Winmm.dll
Jun 26, 2024 13:20:26 GMT 1
ventilo25, dragonjim, and 2 more like this
Post by scalion on Jun 26, 2024 13:20:26 GMT 1
Bonjour les amis, ca faisait longtemps, je suis accapparé par plein de choses, mais là je suis assez content de ma trouvaille. Après une petite discussion avec CHAT-GPT (celui-là il est bon), j'ai pu généré du son avec la librairie "Winmm.dll".
Dans un autre thread ou on discutait de direct sound, on se demandait comment écrire dans le wave en cours de lecture, on n'avait pas trouvé. Là on peut le faire sans problème !!!
Je pense que ca peut toujours servir alors je partage dans la foulée :
Et bonne journée.
$Library "gfawinx"
$Library "UpdateRT"
UpdateRuntime ' Patches GfaWin23.OcxPrivate Const MMSYSERR_NOERROR As Integer = 0
Global Const WAVE_MAPPER As Integer = -1
Global Const WAVE_FORMAT_PCM As Integer = 1
Global Const CALLBACK_FUNCTION As Integer = &H30000
Global Const MMSYSERR_NOERROR = 0
Global Const WAVE_MAPPER = -1
Global Const WAVE_FORMAT_PCM = 1
Global Const CALLBACK_NULL = 0
Global Const WAVERR_STILLPLAYING = 33
Type WAVEFORMATEX
wFormatTag As Short
nChannels As Short
nSamplesPerSec As Integer
nAvgBytesPerSec As Integer
nBlockAlign As Short
wBitsPerSample As Short
cbSize As Short
EndType
Type WAVEHDR
lpData As Long
dwBufferLength As Long
dwBytesRecorded As Long
dwUser As Long
dwFlags As Long
dwLoops As Long
lpNext As Long
reserved As Long
EndType
Declare Function waveOutOpen Lib "winmm.dll" (ByRef hWaveOut As Long, ByVal uDeviceID As Integer, ByRef lpFormat As WAVEFORMATEX, ByVal dwCallback As Long /*WaveCallback*/, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Declare Function waveOutPrepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, ByRef lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long
Declare Function waveOutWrite Lib "winmm.dll" (ByVal hWaveOut As Long, ByRef lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long
Declare Function waveOutClose Lib "winmm.dll" (ByVal hWaveOut As Long) As Long
Declare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, ByVal lpWaveOutHdr As Long, ByVal uSize As Long) As Long
Global bufferLength
Const sampleRate = 44100
Const frequency = 440
Const amplitude = 32760
GenerateWave
PlayWave
Procedure PlayWave
Local Long hWaveOut
Local waveFormat As WAVEFORMATEX
Local waveHeader As WAVEHDR
waveFormat.wFormatTag = WAVE_FORMAT_PCM
waveFormat.nChannels = 1
waveFormat.nSamplesPerSec = sampleRate
waveFormat.nAvgBytesPerSec = sampleRate * 2
waveFormat.nBlockAlign = 2
waveFormat.wBitsPerSample = 16
waveFormat.cbSize = 0
If waveOutOpen(hWaveOut, WAVE_MAPPER, waveFormat, 0, 0, Null) <> MMSYSERR_NOERROR
Beep
Print "Erreur lors de l'ouverture du périphérique audio."
Return
EndIf
waveHeader.lpData = V:waveBuffer(0)
waveHeader.dwBufferLength = bufferLength * 2
waveHeader.dwFlags = 0
waveHeader.dwLoops = 1
If waveOutPrepareHeader(hWaveOut, waveHeader, SizeOf(waveHeader)) <> MMSYSERR_NOERROR
Beep
Print "Erreur lors de la préparation du buffer audio."
Return
EndIf
If waveOutWrite(hWaveOut, waveHeader, SizeOf(waveHeader)) <> MMSYSERR_NOERROR
Beep
Print "Erreur lors de l'écriture du buffer audio."
Return
EndIf
' Attendre que la lecture soit terminée
While waveOutUnprepareHeader(hWaveOut, V:waveHeader, SizeOf(waveHeader)) = WAVERR_STILLPLAYING
Sleep 10
Wend
waveOutClose(hWaveOut)
Return
Procedure GenerateWave
Local i%, sample%
bufferLength = sampleRate * 4 // 4 secondes
Global Dim waveBuffer(bufferLength * 2 - 1) As Byte
For i% = 0 To bufferLength - 1
sample% = amplitude * Sin( Sin(64 * PI * (i / bufferLength) ^ 2) + (2 * PI * frequency * i%) / sampleRate)
waveBuffer(i% * 2) = sample% And &HFF
waveBuffer(i% * 2 + 1) = (sample% >> 8) And &HFF
Next i%
Return
