Visual Basic for Applications/Variable Beep from VBA

Summary thumb|500px|right|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. thumb|500px|right|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. thumb|300px|right|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 See Also