How to play tones of defined pitch, volume and duration?

Check out this link;


http://www.freevbcode.com/ShowCode.asp?ID=3812

Option Compare Database
Option Explicit

Public Declare Function Beep Lib "kernel32" _
  (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

Function Test()
Dim x As Long
For x = 200 To 300 Step 10
Beep x, 100
Next
End Function

That code comes from the same link.

Thanks dds110, but it plays the sound on my PC speaker and I wan't it  played on wave output of my sound card with the ability to set the volume.

I have increased the points to 500 and asked another question which points to this one.

Hi again Davor,

This really just a listening comment.

I tried this myself some time ago, but got bogged down with DirectctX and DLS (Down-Loadable Sounds). Before that I was able to program tones, attack, vibrato etc in stereo on my Amstrad CPC 464. You might know the brand as Schneider. It was a home PC, strictly 8 bit with 32K of user memory. That was in 1985.

Best regards, Graham

Hi!

I know. I was able to produce some sounds on SB16 under DOS, but it was complicated so I forgot the theory behind it, and even if I had the code it would be usless becouse it was C,
so I thought Windows would provide some simpler way (accessible to VB) to do it, but I can't find it anywhere.

I tried DirectX. It can produce some interesting effects like distortion, 3D sound, chorus, but it all works on existing wav files. I never managed to produce any sound myself.

Thanks.

GrahamSkan

Since you said you are listening, I suppose you would be interested in this:

This is what I managed to do with the code vware provided:
 - only one command button and a reference to DirectX 8 is required
----------------------------------------------------------------------------------------
Option Explicit
Dim lpBuffer() As Integer
Dim lBufferSize As Long

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Command1_Click()
    PlaySound 50, 5000
    'Can't be used in a loop, becouse the sound will be choppy
    'Eventual effects have to be applied on a lpBuffer before playing inside PlaySound function
End Sub

Sub PlaySound(ByVal Frequency As Integer, ByVal miliseconds As Integer)
    Dim a As Double
    Dim i As Double
    Dim x As Long
    Dim DX As DirectX8
    Dim DS As DirectSound8
    Dim DSBD1 As DSBUFFERDESC
    Dim DSB As DirectSoundSecondaryBuffer8
    Dim DSFormat As WAVEFORMATEX
    Dim two_pi As Double
    Dim lFrequency&, lSampleRate&, lMultiplier&
   
    two_pi = 3.14159265358979 * 2
       
 'Create the sound and store it in lpBuffer() array
    lFrequency = Frequency
    lSampleRate = 22050
    lMultiplier = lSampleRate \ lFrequency
    lBufferSize = lMultiplier * miliseconds * 2
    ReDim lpBuffer(lBufferSize)
       
        'main loop where actual sinusoidal pattern is created
    Me.Print "Creating sound..."
    DoEvents
    For i = 0 To lBufferSize - 1
        lpBuffer(i) = 32767 * Sin((i + a) * two_pi * lFrequency / lSampleRate)
    Next i
    Me.Cls
 'Play the sound from lpBuffer()
    Set DX = New DirectX8
    Set DS = DX.DirectSoundCreate(vbNullString)
    DS.SetCooperativeLevel Me.hWnd, DSSCL_PRIORITY
     
    With DSFormat
        .nFormatTag = WAVE_FORMAT_PCM
        .nChannels = 2
        .lSamplesPerSec = 22050
        .nBitsPerSample = 16
        .nBlockAlign = .nBitsPerSample / 8 * .nChannels
        .lAvgBytesPerSec = .lSamplesPerSec * .nBlockAlign
    End With
     
    DSBD1.fxFormat = DSFormat
    DSBD1.lBufferBytes = lBufferSize
    Set DSB = DS.CreateSoundBuffer(DSBD1)
    DSB.WriteBuffer 0, 0, lpBuffer(0), DSBLOCK_ENTIREBUFFER
   
    Me.Print "Playing sound..."
    DoEvents
    DSB.Play DSBPLAY_LOOPING
    Sleep miliseconds
    DSB.Stop
    Me.Cls
   
    Set DSB = Nothing
    Set DS = Nothing
    Set DX = Nothing

End Sub
------------------------------------------------------------------------------------