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