Visual Basic for Applications/Variable Beep from VBA

Summary

Figure1:A table of note frequencies with their positional distances from 440Hz.The frequency of any note can be calculated with Frequency = 440 * (2 ^ (n/12)), where n is the distance. Sharps are marked with hash marks (#) and flats with b, otherwise notes are naturals.The notes with two designations occur because the half-note shifting of flats and sharps causes some to have the same frequency.

Figure 2: Simple music score for Ode to Joy with note names and distances from A = 440Hz. The reference point to assign distances is G, always on the second line when using the treble clef.

Figure 3: The international morse code.

This VBA code module examines various uses of the Beep() API. Its parameters are frequency and duration. It has no wait parameter, so chords are not possible, just simple tones. It is stated to work well for Windows 7 versions onwards, but might ignore the parameters for earlier versions. Simple musical scales and tunes are illustrated, in addition to a Morse code text sender.

Beep API Bugs

In the past many problems were found in the use of the Beep API. Since Windows 7, the Beep API has been re-coded by Microsoft to work with computer sound cards. Prior to Windows 7, the API functioned only with an on-board sound chip. Unfortunately, during the transition from sound chips to sound cards, some computer manufacturers still used chips while others used cards. This is the basis of the problem for older Windows versions. No problems should be encountered in the use of the Beep API for recent builds.

Procedure Notes

Several procedures are provided in the module. Copy the entire code into a standard module for testing. The procedures are as follows:

• Beeper() is the basic form of the function. Running it will make a simple tone in the computer's speakers. Note that it does not refer to the alert sounder that is built into Windows, but the speakers used for listening to media. Both the frequency and duration of the sound can be adjusted, though the consistency of the output, being designed for selected frequency use is not very good.
• TestNotes() expands on the basic format. Run this to produce up and down scales. There are two ways to access frequencies:
  • The first is just to enter the exact frequencies for each note in a sequence of code lines; this is the case for the do re me scales, the so-called natural notes, eg, C,D,E,F,G,A,B,C....
  • The other, when the exact frequencies are not known is to use a formula to calculate the frequency based on knowledge of the relative position of the note with respect to a reference point. (See Figures 1 and 2). The reference point in this case is note A = 440 Hz. Figure 1 shows three octaves of notes around 440Hz, and Figure 2 shows how notes in a simple music score relate to note distance. The note-distance value can be used to calculate frequency for any other note. For example, in Figure 2, notice that the G notes have a distance of 10; this and all other note distances are listed in the table of Figure 1. When it is understood that G notes always occupy the second line of the treble clef, a simple score can be marked with both notes and distances, ready for coding.
• SendMorse() sounds out the Morse code for a parameter string. The procedure gives a basic output, with adjustable frequency (Hz) and dot length (milliseconds).
  • Delays are introduced with Delay() for the inter-element (one dot), inter-character (3 dots), and inter-word (7 dots) intervals, in addition to the basic one to three ratio for dots and dashes. All timing is derived from the length of one short dot element. A random element can be added to all timing in Random(), where the maximum percentage of error can be set; this is said to better resemble a human hand rather that the too-perfect program.
  • The convention is to estimate words per minute in terms of dot duration also, as T = 1200 / W where T is dot duration in milliseconds and W is the generated number of words per minute. The international Morse code is given for reference in Figure 3.

The Code

• Modified 24 Dec 18 to add randomness to all timing in SendMorse()
• Modified 24 Dec 18 to add an omitted sCode declaration in SendMorse()
• Modified 23 Dec 18 to correct data in SendMorse() array vSN
• Modified 22 Dec 18 to show use of note distance in a tune.
• Modified 21 Dec 18 to correct timing errors for Morse code procedures.

Run TestBeeper(), TestNotes(), or testSendMorse() to run the various procedures.

Option Explicit
Public Declare PtrSafe Function BeepAPI Lib "kernel32" Alias "Beep" _
             (ByVal Frequency As Long, ByVal Milliseconds As Long) As Long

Sub TestBeeper()
    'run this to test beeper
    
    Dim nFreq As Long, nDur As Long

    nFreq = 800     'frequency (Hertz)
    nDur = 500   'duration (milliseconds)

    'call beeper function
    Beeper nFreq, nDur

End Sub

Function Beeper(nF As Long, nD As Long) As Boolean
    'makes a beep sound of selected frequency and duration
    'This works for NT/2000/XP and beyond.
    'Before that, frequency and duration ignored.
    
    BeepAPI nF, nD

    Beeper = True

End Function

Sub TestNotes()
    'music notes played using known frequencies and those
    'calculated from knowlege of their relative positions'
        
    Dim vAN As Variant, vOTJ As Variant, vOTJD As Variant
    Dim i As Long, nFreq As Long
    Dim nDur As Long, nLen As Long

    'sets the basic note duration
    nDur = 500

    'store the specific frequencies in array - zero based...
    'these frequencies are for do,re,me,fa,so,la,te,do based on middle C =261.63Hz (262)
    'CDEFGABC
    vAN = Array(262, 294, 330, 349, 392, 440, 494, 523)
    
    'or store a jingle in note difference notation. Ode To Joy on beeper.
    vOTJ = Array(7, 7, 8, 10, 10, 8, 7, 5, 3, 3, 5, 7, 7, 5, 5) 'note positions from 440Hz
    vOTJD = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2)  'durations
    
    'scales up
    'CDEFGABC
    'do re me fa so la te do
    For i = 0 To 7
        nFreq = vAN(i)
        BeepAPI nFreq, nDur
    Next i

    Delay 1000 'delay one second

    'scales down
    'CBAGFEDC
    'do te la so fa me re do
    For i = 7 To 0 Step -1
        nFreq = vAN(i)
        BeepAPI nFreq, nDur
    Next i

    Delay 1000 'delay one second

    '34 notes, naturals, sharps and flats
    'played using note position from 440Hz
    For i = -5 To 28
        nFreq = CInt(440 * 2 ^ (i / 12))
        BeepAPI nFreq, nDur
    Next i

    Delay 1000 'delay one second

    'Ode to Joy - albeit crude, using note distance only
    For i = 0 To 14
       nFreq = CInt(440 * 2 ^ (vOTJ(i) / 12))
       BeepAPI nFreq, 400 * vOTJD(i)
    Next i
   
   Delay 1000 'delay one second
   
   'or use direct entries to make a custom sound
    BeepAPI 262 * 2, 200
    BeepAPI 494 * 2, 200
    BeepAPI 494 * 2, 200
    BeepAPI 262 * 2, 500
    
End Sub

Sub testSendMorse()
    'run this to test the Morse code sender
    'integers and simple alphabet only
    
    Dim sIn As String
    Dim start As Single, ends As Single
    
    sIn = "The quick brown fox jumps over the lazy dog 0123456789 times"
    
    'start = Timer
    SendMorse sIn, 440, 120 'string,freq (Hz),dot length (mS)

    'ends = Timer - start
    'MsgBox ends
End Sub

Sub SendMorse(ByVal sIn As String, nUF As Single, nUL As Single)
    'Sounds out Morse code for input string sIn
    'Parmeters frequency(Hz) and dot length(mS)

    Dim vSL As Variant, vSN As Variant, vM As Variant
    Dim i As Long, j As Long, nAsc As Integer
    Dim sWord As String, sCode As String

    'check that there is a decent string input
    If Trim(sIn) = "" Then
        MsgBox "Illegal characters in input string - closing"
        Exit Sub
    End If
        
    'load letter array with morse code- 1 for dot and 3 for dah
    vSL = Array("13", "3111", "3131", "311", "1", "1131", "331", "1111", "11", _
                "1333", "313", "1311", "33", "31", "333", "1331", "3313", "131", _
                "111", "3", "113", "1113", "133", "3113", "3133", "3311") 'a,b,c,...z
    'load number array with morse code- 1 for dot and 3 for dah
    vSN = Array("33333", "13333", "11333", "11133", "11113", _
                "11111", "31111", "33111", "33311", "33331")              '0,1,2,...9
        
    'split the input string into words
    vM = Split(Trim(sIn), " ") 'zero based
    
    For i = LBound(vM) To UBound(vM) 'step through words
        'get one word at a time
        sWord = LCase(vM(i)) 'current word
        'get one chara at a time
        For j = 1 To Len(sWord)
            'look up chara asci code
            nAsc = Asc(Mid(sWord, j, 1))
            'get morse sequence from array
            Select Case nAsc
                Case 97 To 122 'a letter
                    sCode = vSL(nAsc - 97)
                    MakeBeeps sCode, nUL, nUF
                    If j <> Len(sWord) Then
                        Delay (nUL * 3) 'add 3 spaces between letters
                    End If
                Case 48 To 57  'an integer
                    sCode = vSN(nAsc - 48)
                    MakeBeeps sCode, nUL, nUF
                    If j <> Len(sWord) Then
                        Delay (nUL * 3) 'add 3 spaces between letters
                    End If
                Case Else
                    MsgBox "Illegal character in input" & vbCrLf & _
                           "Only A-Z and 0-9 permitted."
            End Select
            
        Next j
        If i <> UBound(vM) Then Delay (nUL * 7) 'add 7 spaces between words
    Next i
    
End Sub
Function MakeBeeps(ByVal sIn As String, ByVal nUL As Single, ByVal nUF As Single) As Boolean
    'makes beep sounds for one character based on coded input string
    
    Dim i As Long, j As Long, nLen As Long
    Dim nT As Single, nE As Single
    
    For i = 1 To Len(sIn)
        'get character element
        nLen = CInt(Mid(sIn, i, 1))
        Select Case nLen
        Case 1
            BeepAPI nUF, nUL + Random(nUL)
            If i <> Len(sIn) Then Delay nUL
        Case 3
            BeepAPI nUF, (3 * nUL) + Random(3 * nUL)
            If i <> Len(sIn) Then Delay nUL
        Case Else
            MsgBox "error"
        End Select
    Next i
            
    MakeBeeps = True

End Function

Function Random(nDot As Single) As Single
    'adds a random variation to the timing
    'used to better hide machine code signature
    'nRand = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
    
    Dim nRand As Long, nPercent As Single
    Dim nU As Long, nL As Long
    
    'set a number here for max error percentage
    'eg; 10 for ten percent error, 0 for none.
    nPercent = 10 'max percent plus and minus

    'initialize the random generator
    Randomize
    
    'generate small random number as the timing error
    
    nRand = Int((nDot * nPercent / 100 + nDot * nPercent / 100 + 1) * Rnd - nDot * nPercent / 100)

    Random = nRand

End Function

Sub Delay(nD As Single)
    'delays for nD milliseconds
    'randomness set in Random()
    
    Dim start As Single
   
    nD = nD + Random(nD) 'add randomness to intention
    
    start = Timer  ' Set start time.
    Do While Timer < start + nD / 1000
        DoEvents    ' Yield to other processes.
    Loop

End Sub