Solved

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

Posted on 2004-03-30
10
650 Views
Last Modified: 2012-05-04
Hi!

How do I make a sound card produce some sounds that are not saved to a file ( WAV, MIDI, etc.), but generated at runtime.

If I'm not mistaking, Quick Basic had a function called: Sound ( pitch, duration ) which could generate a sound of defined pitch ( in Hz ) and duration ( in miliseconds i think )
Off course, the sound was played on PC speaker.

So following routine:

duration = 10
For x = 100 To 2000
     Sound (x,duration)
Next X

would have produced a sound whoose pitch was higher every 10 miliseconds.

I would like to have the same thing in Visual Basic, but played on Sound Card, and with the ability to define volume of the sound.
How do I do that?
0
Comment
Question by:dbrckovi
10 Comments
 
LVL 8

Expert Comment

by:dds110
ID: 10716162
0
 
LVL 8

Expert Comment

by:dds110
ID: 10716336
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
0
 
LVL 8

Expert Comment

by:dds110
ID: 10716341
That code comes from the same link.
0
 
LVL 11

Author Comment

by:dbrckovi
ID: 10718002
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.
0
 
LVL 11

Author Comment

by:dbrckovi
ID: 10836174
I have increased the points to 500 and asked another question which points to this one.
0
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 
LVL 76

Expert Comment

by:GrahamSkan
ID: 10837097
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
0
 
LVL 11

Author Comment

by:dbrckovi
ID: 10839852
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.
0
 
LVL 1

Accepted Solution

by:
vware earned 250 total points
ID: 10866990
Hi. The following code is not by myself, just found it somewhere. However, I suppose it does what you want to do - create sounds with DirectX instead of playing sound files.
You will need a txtEnglish textbox and cmdPlay command button on your form. Have fun with this crazy thing... Plays english characters in morse code.



'If the duration of a dot is taken to be one unit
'then that of a dash is three units.
'The space between the components of one character is one unit,
'between characters is three units and between words seven units.
'To indicate that a mistake has been made and for the receiver to
'delete the last word send ........ (eight dots).



Option Explicit
Dim lpBuffer() As Integer
Dim lBufferSize As Long

Private Const MorseUnitLength = 100

Private Const MorseDash = 3
Private Const MorseDot = 1
Private Const MorseWordGap = 7
Private Const morseUnitComponentGap = 1
Private Const morseCharacterGap = 3

Private aMorseCode() As String

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

Private Function createBaseSound() As Integer
    Dim two_pi As Double
    two_pi = 8 * Atn(1)
    Dim lFrequency&, lSampleRate&, lMultiplier&, I&
    lFrequency = 100
    lSampleRate = 22050
    lMultiplier = lSampleRate \ lFrequency
    lBufferSize = lMultiplier * 500
    ReDim lpBuffer(lBufferSize)
    For I = 0 To lBufferSize - 1
        '// For 16-bit integer PCM
        lpBuffer(I) = 32767 * Sin(I * two_pi * lFrequency / lSampleRate)
    Next
    lpBuffer() = lpBuffer()
    lBufferSize = lBufferSize
     
       
End Function


Private Sub cmdPlay_Click()
    Dim sSequence As String
    Dim iRet As Integer
   
    iRet = CreateMorseCodeSequence(txtEnglish.Text, sSequence)
    If iRet <> -1 Then
        Play sSequence
    Else
        MsgBox "String was not able to converted to Morse Code", vbInformation
    End If
End Sub

Private Sub Form_Load()
    Dim iRet As Integer
    ReDim aMorseCode(33 To 90) ' The numbers are the ascii value
   
    'NUMBERS
    aMorseCode(48) = "-----" '0
    aMorseCode(49) = ".----" '1
    aMorseCode(50) = "..---" '2
    aMorseCode(51) = "...--" '3
    aMorseCode(52) = "....-" '4
    aMorseCode(53) = "....." '5
    aMorseCode(54) = "-...." '6
    aMorseCode(55) = "--..." '7
    aMorseCode(56) = "---.." '8
    aMorseCode(57) = "----." '9

    'PUNCTUATION
    aMorseCode(33) = ".----." '!
    aMorseCode(34) = ".-..-." '"
    aMorseCode(40) = "-.--.-" '(
    aMorseCode(44) = "--..--" ',
    aMorseCode(45) = "-....-" '-
    aMorseCode(46) = ".-.-.-" '.
    aMorseCode(47) = "-..-. " '/
    aMorseCode(58) = "---..." ':
    aMorseCode(63) = "..--.." '?
 
    'CHARACTERS
    aMorseCode(65) = ".-" 'A
    aMorseCode(66) = "-..." 'B
    aMorseCode(67) = "-.-." 'C
    aMorseCode(68) = "-.." 'D
    aMorseCode(69) = "." 'E
    aMorseCode(70) = "..-." 'F
    aMorseCode(71) = "--." 'G
    aMorseCode(72) = "...." 'H
    aMorseCode(73) = ".." 'I
    aMorseCode(74) = ".---" 'J
    aMorseCode(75) = "-.-" 'K
    aMorseCode(76) = ".-.." 'L
    aMorseCode(77) = "--" 'M
    aMorseCode(78) = "-." 'N
    aMorseCode(79) = "---" 'O
    aMorseCode(80) = ".--." 'P
    aMorseCode(81) = "--.-" 'Q
    aMorseCode(82) = ".-." 'R
    aMorseCode(83) = "..." 'S
    aMorseCode(84) = "-" 'T
    aMorseCode(85) = "..-" 'U
    aMorseCode(86) = "...-" 'V
    aMorseCode(87) = ".--" 'W
    aMorseCode(88) = "-..-" 'X
    aMorseCode(89) = "-.--" 'Y
    aMorseCode(90) = "--.." 'Z
       
    iRet = createBaseSound
   
End Sub

Private Function CreateMorseCodeSequence(ByVal sEnglish As String, ByRef sSequence As String) As Integer
Dim x As Long
Dim sChar As String
Dim iAscii As Integer

sSequence = ""

For x = 1 To Len(sEnglish)
    sChar = Mid(sEnglish, x, 1)
    iAscii = Asc(UCase(sChar))
    Select Case iAscii
    Case 32
        sSequence = sSequence & "W"
    Case 33 To 90
        If aMorseCode(iAscii) <> "" Then
            sSequence = sSequence & aMorseCode(iAscii) & "C"
        Else
            GoTo ErrHandler
        End If
    Case Else
            GoTo ErrHandler
    End Select
Next x
Exit Function
ErrHandler:
Select Case Err.Number
Case Else
        MsgBox "Character not yet developed in MorseCode array", vbInformation
        CreateMorseCodeSequence = -1
End Select
End Function


Private Sub Play(sSequence As String)
   
    Dim x As Long
    Dim DX As DirectX8
    Dim DS As DirectSound8
    Dim DSBD1 As DSBUFFERDESC
    Dim DSB As DirectSoundSecondaryBuffer8
    Dim DSFormat As WAVEFORMATEX
     
    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
   
    Dim lTime As Long
    For x = 1 To Len(sSequence)
        Select Case Mid$(sSequence, x, 1)
            Case "."
                DSB.Play DSBPLAY_LOOPING
                Sleep MorseUnitLength * MorseDot
                DSB.Stop
                Sleep MorseUnitLength * morseUnitComponentGap
            Case "-"
                DSB.Play DSBPLAY_LOOPING
                Sleep MorseUnitLength * MorseDash
                DSB.Stop
                Sleep MorseUnitLength * morseUnitComponentGap
            Case "C" ' Character Gap
                Sleep MorseUnitLength * morseCharacterGap
            Case "W" ' Word Gap
                Sleep MorseUnitLength * MorseWordGap
            Case Else
                MsgBox "Tone not developed", vbCritical
        End Select
           
    Next x
    Set DSB = Nothing
    Set DS = Nothing
    Set DX = Nothing

End Sub
0
 
LVL 11

Author Comment

by:dbrckovi
ID: 10867365
Thanks.
0
 
LVL 11

Author Comment

by:dbrckovi
ID: 10867631
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
------------------------------------------------------------------------------------
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now