Bonjour a tous!
Voila j'ai un petit pb j'ai un prog qui se sert de sons. je crée dans le programmes des sons en fonction de la fréquence d'une note du temps d'emision etc..
mais je voudrai lire ces sons de maniere simultanés voila le code que j'utilise (il n'est pas de moi):
Option Explicit
Private Type lpSoundBuffer
Name As String
Buffer() As Byte
nBuffer As Long
End Type
Private Sounds() As lpSoundBuffer
Private Const VarTps = 22050 '44100
Private Const pi = 3.14159265358979
Private DX As DirectX8
Private DS As DirectSound8
Dim PCM As WAVEFORMATEX
Public Function CreateSound(ByVal sName As String, _
ByVal nFrequency As Long, ByVal nVolume As Single, _
nBufferSize As Long, Optional ByVal bSquare As Boolean) As Long
Dim I As Long, C As Single
Dim lpBuffer() As Byte, nBuffer As Long
Dim bFoundSound As Boolean
Dim iSoundNumber As Integer
Dim x As Integer
On Error GoTo ErrHandler
nBuffer = VarTps * nBufferSize
ReDim lpBuffer(nBuffer)
For I = 0 To nBuffer - 1
lpBuffer(I) = 128 + 127 * (Sin(I * (2 * pi) * _
nFrequency / VarTps) * nVolume)
Next I
iSoundNumber = -1
For x = LBound(Sounds) To UBound(Sounds)
' Replace a sound with no name before creating new ones.
If Sounds(x).Name = sName Or Sounds(x).Name = "" Then
bFoundSound = True
iSoundNumber = x
Exit For
End If
Next x
If iSoundNumber = -1 Then
iSoundNumber = UBound(Sounds) + 1
ReDim Preserve Sounds(x + 1)
End If
Sounds(iSoundNumber).Buffer = lpBuffer()
Sounds(iSoundNumber).Name = sName
Sounds(iSoundNumber).nBuffer = UBound(lpBuffer)
CreateSound = 1
Exit Function
ErrHandler:
Err.Raise vbObjectError, "DirectSound8Wrapper.CreateSound", ""
End Function
Public Function PlaySound(sName As String) As Long
Dim dsdbCursor As DSCURSORS
Dim dsStat As CONST_DSBSTATUSFLAGS
Dim iSoundNumber As Integer
Dim x As Integer
Dim DSBD As DSBUFFERDESC
Dim DSB As DirectSoundSecondaryBuffer8
iSoundNumber = -1
For x = LBound(Sounds) To UBound(Sounds)
If Sounds(x).Name = sName And Sounds(x).Name <> "" Then
iSoundNumber = x
Exit For
End If
Next x
If iSoundNumber <> -1 Then
DSBD.lFlags = DSBCAPS_STATIC
DSBD.lBufferBytes = Sounds(iSoundNumber).nBuffer
DSBD.fxFormat = PCM
Set DSB = DS.CreateSoundBuffer(DSBD)
DSB.GetCurrentPosition dsdbCursor
DSB.WriteBuffer 0, 1, Sounds(iSoundNumber).Buffer(0), _
DSBLOCK_ENTIREBUFFER
DSB.SetCurrentPosition dsdbCursor.lWrite
DSB.Play DSBPLAY_DEFAULT
dsStat = DSB.GetStatus
Do Until dsStat <> DSBSTATUS_PLAYING
dsStat = DSB.GetStatus
Loop
DoEvents
Else
PlaySound = -1
End If
Set DSB = Nothing
End Function
Private Sub Class_Initialize()
Set DX = New DirectX8
Set DS = DX.DirectSoundCreate(vbNullString)
Load frmCoop
' Simple error check
If DX Is Nothing Then GoTo ErrHandler
If DS Is Nothing Then GoTo ErrHandler
PCM.nFormatTag = WAVE_FORMAT_PCM
PCM.nChannels = 2
PCM.lSamplesPerSec = VarTps
PCM.nBitsPerSample = 8 ' 8 or 16
PCM.nBlockAlign = (PCM.nChannels * PCM.nBitsPerSample) / 8
PCM.lAvgBytesPerSec = PCM.lSamplesPerSec * PCM.nBlockAlign
ReDim Sounds(0)
' On a besoin de la form frmCoop pour cela :
DS.SetCooperativeLevel frmCoop.hWnd, DSSCL_PRIORITY
Exit Sub
ErrHandler:
Err.Raise vbObjectError, "clsDirectXBeep.Class_Initialise", _
"Unable to initialise DirectSound"
Class_Terminate
End Sub
Private Sub Class_Terminate()
On Error Resume Next
Set DS = Nothing
Set DX = Nothing
Unload frmCoop
End Sub
///////////////////////////////////////////
et pour lire les son j'ai donc une fonction:
Sub Emettre(Frequence As String)
If txttps = "" Then 'Si le txttps est vide
MsgBox "Vous devez inscrire la durée du son", vbCritical, "Attention!"
Exit Sub
ElseIf Val(txttps) > 20 Then
MsgBox "La durée du son, en secondes, ne doit pas dépasser 20 secondes", vbCritical, "Attention!"
txttps = "" 'Vide txttps
Exit Sub
Else 'Si txttps n'est ni vide, ni suppérieur à 20
Dim objBeep As Object
On Error Resume Next
Set objBeep = CreateObject("rtcDXBeep.clsDirectXBeep")
objBeep.CreateSound "Son1", Frequence, 1, txttps, False
'crée le son nommé "Son1"
objBeep.PlaySound "Son1"
'Joue le son d'une fréquence donnée, avec la durée voulue
'La durée est définie par txttps
lblfreq = Frequence 'Indique la fréquence dans lblFreq
End If
End Sub
////////////////////////////////////////
voila si quelqu'un peu me dire comment je pe lire plusieurs son en meme temps avec ca ce serai cool.
et si quelqu'un comprend ce code et peu me mettre des commentaires pour que je le comprenne mieux parce que j'ai un peu de mal la.
merci d'avance
mailto:S0KARISS@hotmail.com