Create a sound by code

[opus]

Hi, I need to create a sound by code, whow could I do that.
Would the WAV format be useable?

I need to generate an echo-ranging type of sound, that is one tone with the echo of that tone after varying times, and the the frequency of that echo can be different from the starting tone. During the run of that echo-ranging a random noise should be heared.

Any help would be appriciated.

[CVMichael]

Take a look at this thread: create wav file

I also know how to add echo to it, but I can't do it right now cuz I'm at work. I don't know if I'll have time even when I get home. Anyways, I'll do it when I have time.

[dannymking]

You use to be able to declare functions to use the "Sound.drv" in vb5 and I have some code that you can have.. but I'm not sure if it will work..

[CVMichael]

Here it is, with echo too...
It will create some sample files in C drive

Option Explicit
 
Private Type tWAVEFORMATEX
    wFormatTag As Integer
    nChannels As Integer
    nSamplesPerSec As Long
    nAvgBytesPerSec As Long
    nBlockAlign As Integer
    wBitsPerSample As Integer
    cbSize As Integer
    ExtraData(1 To 32) As Byte ' makes the structure 50 bytes long
End Type
 
Private Type FileHeader
    lRiff As Long
    lFileSize As Long
    lWave As Long
    lFormat As Long
    lFormatLength As Long
End Type
 
Private Type WaveFormat
    wFormatTag As Integer
    nChannels As Integer
    nSamplesPerSec As Long
    nAvgBytesPerSec As Long
    nBlockAlign As Integer
    wBitsPerSample As Integer
End Type
 
Private Type ChunkHeader
    lType As Long
    lLen As Long
End Type
 
Private Sub Form_Load()
    Dim Buff(0 To 44100 * 5) As Integer ' 5 Seconds of sound
    
    GenerateTone 440, Buff, 1, , , 44100 * 0.2
    AddEcho Buff, 44100 * 0.35, , 1.5
    SaveWaveFile "C:\test_Wave_1.wav", Buff
    
    Erase Buff
    GenerateTone 440, Buff, 1, , , 44100 * 0.3
    AddEcho Buff, 44100 * 0.6, , 1.5
    SaveWaveFile "C:\test_Wave_2.wav", Buff
    
    Erase Buff
    GenerateDualTone 440, 438.6, Buff, 0.5, 0.5, , , 44100 * 0.35
    AddEcho Buff, 44100 * 0.45, , 1.1
    SaveWaveFile "C:\test_Wave_3.wav", Buff
    
    Erase Buff
    GenerateDualTone 440, 1000, Buff, 0.5, 0.5, , , 44100 * 0.35
    AddEcho Buff, 44100 * 0.1, , 1.1
    AddEcho Buff, 44100 * 0.55, , 1.4
    SaveWaveFile "C:\test_Wave_4.wav", Buff
    
    Erase Buff
    GenerateDualTone 400, 700, Buff, 0.5, 0.5, , , 44100 * 0.4
    AddEcho Buff, 44100 * 0.5, , 1.1
    GenerateDualTone 500, 800, Buff, 0.5, 0.5, , 10000, 44100 * 0.4
    AddEcho Buff, 44100 * 0.45, , 1.3
    SaveWaveFile "C:\test_Wave_5.wav", Buff
End Sub
 
Private Sub GenerateTone(ByVal Frequency As Single, IntBuff() As Integer, Optional Amplitude As Single = 1, Optional SamplesPerSec As Long = 44100, Optional Startpos As Long = 0, Optional Length As Long = -1)
    Dim K As Long, V1 As Double
    Const PI As Double = 3.14159265358979
 
    V1 = SamplesPerSec / (PI * 2 * Frequency)
    
    If Length = -1 Then Length = UBound(IntBuff) - Startpos
    
    For K = Startpos To Startpos + Length
        IntBuff(K) = CInt(Fix(Sin(K / V1) * (32766.5 * Amplitude)))
    Next K
End Sub
 
Private Sub GenerateDualTone(ByVal Frequency1 As Single, ByVal Frequency2 As Single, IntBuff() As Integer, Optional Amplitude1 As Single = 1, Optional Amplitude2 As Single = 1, Optional SamplesPerSec As Long = 44100, Optional Startpos As Long = 0, Optional Length As Long = -1)
    Dim K As Long, V1 As Double, V2 As Double, Sample As Long
    Const PI As Double = 3.14159265358979
 
    V1 = SamplesPerSec / (PI * 2 * Frequency1)
    V2 = SamplesPerSec / (PI * 2 * Frequency2)
    
    If Length = -1 Then Length = UBound(IntBuff) - Startpos
    
    For K = Startpos To Startpos + Length
        Sample = Sin(K / V1) * (32766.5 * Amplitude1) + Sin(K / V2) * (32766.5 * Amplitude2)
        
        If Sample < -32767 Then Sample = -32767
        If Sample > 32767 Then Sample = 32767
        
        IntBuff(K) = Sample
    Next K
End Sub
 
Private Sub AddEcho(IntBuff() As Integer, ByVal Delay As Long, Optional Startpos As Long = 0, Optional ByVal Strength As Single = 1)
    Dim K As Long, NewSample As Long
    
    For K = Startpos + Delay To UBound(IntBuff)
        NewSample = Fix((IntBuff(K - Delay) / 2 * Strength) + IntBuff(K) / 2)
        
        If NewSample < -32767 Then NewSample = -32767
        If NewSample > 32767 Then NewSample = 32767
        
        IntBuff(K) = NewSample
    Next K
End Sub
 
Private Sub SaveWaveFile(ByVal WaveFileName As String, ByRef Buffer() As Integer, Optional SamplesPerSec As Long = 44100)
    Dim WF As tWAVEFORMATEX
    
    WF.wFormatTag = 1 'WAVE_FORMAT_PCM
    WF.nChannels = 1
    WF.wBitsPerSample = 16
    WF.nSamplesPerSec = SamplesPerSec
    
    WF.nBlockAlign = (WF.wBitsPerSample * WF.nChannels) \ 8
    WF.nAvgBytesPerSec = WF.nSamplesPerSec * WF.nBlockAlign
    
    Open WaveFileName For Binary Access Write Lock Write As #1
        WaveWriteHeader 1, WF
        Put #1, , Buffer
        WaveWriteHeaderEnd 1
    Close #1
End Sub
 
Private Sub WaveWriteHeader(ByVal OutFileNum As Integer, WaveFmt As tWAVEFORMATEX)
    Dim header As FileHeader
    Dim HdrFormat As WaveFormat
    Dim chunk As ChunkHeader
    
    With header
        .lRiff = &H46464952 ' "RIFF"
        .lFileSize = 0
        .lWave = &H45564157 ' "WAVE"
        .lFormat = &H20746D66 ' "fmt "
        .lFormatLength = Len(HdrFormat)
    End With
    
    With HdrFormat
        .wFormatTag = WaveFmt.wFormatTag
        .nChannels = WaveFmt.nChannels
        .nSamplesPerSec = WaveFmt.nSamplesPerSec
        .nAvgBytesPerSec = WaveFmt.nAvgBytesPerSec
        .nBlockAlign = WaveFmt.nBlockAlign
        .wBitsPerSample = WaveFmt.wBitsPerSample
    End With
    
    chunk.lType = &H61746164 ' "data"
    chunk.lLen = 0
    
    Put #OutFileNum, 1, header
    Put #OutFileNum, , HdrFormat
    Put #OutFileNum, , chunk
End Sub
 
Private Sub WaveWriteHeaderEnd(ByVal OutFileNum As Integer)
    Dim header As FileHeader
    Dim HdrFormat As WaveFormat
    Dim chunk As ChunkHeader
    Dim Lng As Long
    
    Lng = LOF(OutFileNum)
    Put #OutFileNum, 5, Lng
    
    Lng = LOF(OutFileNum) - (Len(header) + Len(HdrFormat) + Len(chunk))
    Put #OutFileNum, Len(header) + Len(HdrFormat) + 5, Lng
End Sub

[opus]

Thanks CVMichael, that will get me starting. I will look at the code after the weekend. (There is another reality besides this one ;-) )