Using Excel VBA and MIDI to Play Scales

In this post, I can going to demonstrate how you can use VBA to interact with the MIDI capabilities of your PC to play a simple musical scale. In music, scales consist of a series of notes, that are either a semitone or wholetone (in pitch) apart from each other. In this example, we are going to play a C major diatonic scale. This will consist of 8 notes starting with C and finishing with the same note an octave higher.

C D E F G A B C

For a major scale, the interval between the 3rd and 4th notes (E & F) and the 7th and 8th notes (B & C) is a semitone. For the rest of the notes, the interval is going to be a wholetone. This will be an important thing to note, when it comes to coding the scale.

For the solution, I have created two classes called csNote and csMidi:

The class csNote, is going to be used to model each musical note within the scale. Note objects derived from this class, will have all the attributes required for the note to be played by the csMidi class. The Note class will also allow us to specify instructions in musical language, so that they can be translated into MIDI language for the csMidi class to understand. The csMidi class will encapsulate all the lower level code required for playing MIDI sounds on our PC. The code below shows how the two classes are used to play the scale:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

Option Explicit   Public Sub PlayMajorScale()     Dim oPiano    As New csMidi     Dim oNote     As New csNote     Dim intCount  As Integer       oNote.NoteName = "C"     oNote.OctaveNo = oNote.MiddleOctave     For intCount = 1 To 8         DoEvents         oPiano.PlayNote oNote         Select Case intCount         Case 3, 7             oNote.MoveSemiTone oNote.Up         Case Else             oNote.MoveWholeTone oNote.Up         End Select     Next     Set oNote = Nothing     Set oPiano = Nothing End Sub

A Key of C is defined as well as a starting octave (this is the pitch range for the note) for the scale. The code makes 8 note iterations for the scale. With each iteration it moves the note either a wholetone or semitone up from the previous note until it reaches the last note. That is all that is required to play the scale! The code for both of the classes is presented below:

Note Class (csNote)

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118

Option Explicit Option Base 1   Private Const INT_ACOUSTIC_GRAND        As Integer = 0 Private Const INT_DEFAULT_NOTE_LENGTH   As Integer = 500 Private Const INT_MAX                   As Integer = 127 Private Const INT_MIN                   As Integer = 0 Private Const INT_DEFAULT_OCTAVE_RANGE  As Integer = 5 Private Const INT_MIDDLE_OCTAVE_RANGE   As Integer = 5 Private Const STR_DEFAULT_NOTE_NAME     As String = "C"   Private mintInstrument                  As Integer Private mintVolume                      As Integer Private mintLength                      As Integer Private mintNote                        As Integer Private mintOctaveNo                    As Integer Private mstrNoteName                    As String   Private Enum ENU_DIRECTION     Higher = 1     Lower = 2 End Enum   Private Sub Class_Initialize()     mintInstrument = INT_ACOUSTIC_GRAND     mintVolume = INT_MAX     mintLength = INT_DEFAULT_NOTE_LENGTH     mstrNoteName = STR_DEFAULT_NOTE_NAME     mintOctaveNo = INT_DEFAULT_OCTAVE_RANGE     mintNote = GetNoteNumber() End Sub   Public Property Get Up() As Integer     Up = ENU_DIRECTION.Higher End Property   Public Property Get Down() As Integer     Down = ENU_DIRECTION.Lower End Property   Public Property Get Instrument()      Instrument = mintInstrument End Property   Public Property Let Volume(ByVal Value)     If (Value > INT_MIN) And (Value < INT_MAX) Then         mintVolume = Value     End If End Property   Public Property Get Volume()     Volume = mintVolume End Property    Public Property Let NoteLength(ByVal Value)     mintLength = Value End Property   Public Property Get NoteLength()     NoteLength = mintLength End Property   Public Property Let NoteName(ByVal Value)     mstrNoteName = Value     mintNote = GetNoteNumber() End Property   Public Property Get NoteName()     NoteName = mstrNoteName End Property   Public Property Get NoteNumber()     NoteNumber = mintNote End Property   Public Property Get MiddleOctave()     MiddleOctave = INT_MIDDLE_OCTAVE_RANGE End Property   Public Property Let OctaveNo(ByVal Value)     mintOctaveNo = Value End Property   Public Sub MoveSemiTone(ByVal intDirection As Integer, Optional ByVal iNum As Integer = 1)     MoveNote ((1 * iNum) * IIf(intDirection = ENU_DIRECTION.Lower, -1, 1)) End Sub   Public Sub MoveWholeTone(ByVal intDirection As Integer, Optional ByVal iNum As Integer = 1)     MoveNote ((2 * iNum) * IIf(intDirection = ENU_DIRECTION.Lower, -1, 1)) End Sub   Private Sub MoveNote(ByVal intMargin As Integer)     mintNote = mintNote + intMargin End Sub   Private Function GetNoteNumber()     Dim iBase           As Integer     Dim arrBaseNoteC    As Variant     arrBaseNoteC = Array(12, 24, 36, 48, 60, 72, 84, 96, 108)     iBase = arrBaseNoteC(mintOctaveNo)     Select Case mstrNoteName     Case "C"         iBase = iBase + 0     Case "D"         iBase = iBase + 2     Case "E"          iBase = iBase + 4     Case "F"          iBase = iBase + 5     Case "G"          iBase = iBase + 7     Case "A"          iBase = iBase + 9     Case "B"          iBase = iBase + 11     End Select     GetNoteNumber = iBase End Function

Midi Class (csMidi)

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145

Option Explicit   Private Const MAXPNAMELEN               As Integer = 32 Private Const MMSYSERR_BASE             As Integer = 0 Private Const MMSYSERR_BADDEVICEID      As Integer = (MMSYSERR_BASE + 2) Private Const MMSYSERR_INVALPARAM       As Integer = (MMSYSERR_BASE + 11) Private Const MMSYSERR_NODRIVER         As Integer = (MMSYSERR_BASE + 6) Private Const MMSYSERR_NOMEM            As Integer = (MMSYSERR_BASE + 7) Private Const MMSYSERR_INVALHANDLE      As Integer = (MMSYSERR_BASE + 5) Private Const MIDIERR_BASE              As Integer = 64 Private Const MIDIERR_STILLPLAYING      As Integer = (MIDIERR_BASE + 1) Private Const MIDIERR_NOTREADY          As Integer = (MIDIERR_BASE + 3) Private Const MIDIERR_BADOPENMODE       As Integer = (MIDIERR_BASE + 6)   Private Type MIDIOUTCAPS    wMid             As Integer    wPid             As Integer    wTechnology      As Integer    wVoices          As Integer    wNotes           As Integer    wChannelMask     As Integer    vDriverVersion   As Long    dwSupport        As Long    szPname          As String * MAXPNAMELEN End Type   Private Declare Function midiOutGetNumDevs Lib "winmm" () As Integer Private Declare Function midiOutGetDevCaps Lib "winmm.dll" Alias "midiOutGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As MIDIOUTCAPS, ByVal uSize As Long) As Long Private Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long Private Declare Function midiOutOpen Lib "winmm.dll" (lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long Private Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)   Private mlngNumDevices     As Long Private mlngCurDevice      As Long Private mlngHmidi          As Long Private mlngRc             As Long Private mlngMidiMsg        As Long Private mlngMiPrivatesg    As Long Private mintChannel        As Integer Private mintVolume         As Integer Private mintNoteLength     As Integer Private mintMidiNote       As Integer Private mintInstrument     As Integer Private mstrDeviceName     As String Private mblnIsDeviceOpen   As Boolean   Private Const INT_DEFAULT_CHANNEL       As Integer = 0 Private Const INT_DEFAULT_VOLUME        As Integer = 127 Private Const INT_DEFAULT_NOTE_LENGTH   As Integer = 1000 Private Const INT_DEFAULT_CUR_DEVICE    As Integer = 0   Private Sub Class_Initialize()     mintChannel = INT_DEFAULT_CHANNEL     mlngCurDevice = INT_DEFAULT_CUR_DEVICE     mintVolume = INT_DEFAULT_VOLUME     mintNoteLength = INT_DEFAULT_NOTE_LENGTH     mblnIsDeviceOpen = False     Call OpenDevice End Sub   Private Sub Class_Terminate()     Call CloseDevice End Sub   Private Sub OpenDevice() On Error GoTo ERR_HANDLER:     If Not mblnIsDeviceOpen Then         mlngRc = midiOutClose(mlngHmidi)         mlngRc = midiOutOpen(mlngHmidi, mlngCurDevice, 0, 0, 0)         If (mlngRc <> 0) Then             MsgBox "Couldn't open midi out, lngc = " & mlngRc             mblnIsDeviceOpen = False         End If         mblnIsDeviceOpen = True     End If     Exit Sub ERR_HANDLER:     Debug.Print "Open DLL Error:=" & Err.LastDllError     mblnIsDeviceOpen = False End Sub   Private Sub CloseDevice()     If mblnIsDeviceOpen Then         mlngRc = midiOutClose(mlngHmidi)         mblnIsDeviceOpen = False     End If End Sub   Private Sub StartNote()     mlngMidiMsg = &H90 + (mintMidiNote * &H100) + (mintVolume * &H10000) + mintChannel     midiOutShortMsg mlngHmidi, mlngMidiMsg End Sub   Private Sub StopNote()     mlngMidiMsg = &H80 + (mintMidiNote * &H100) + mintChannel     midiOutShortMsg mlngHmidi, mlngMidiMsg End Sub   Private Sub PauseNote()     Sleep mintNoteLength End Sub   Public Sub PlayNote(ByVal note As csNote)     mintNoteLength = note.NoteLength     mintVolume = note.Volume     mintInstrument = note.Instrument     mintMidiNote = note.NoteNumber     Call StartNote     Call PauseNote End Sub   Private Sub UpdateInstrument()     If mblnIsDeviceOpen = True Then         mlngMidiMsg = (mintInstrument * 256) + &HC0 + mintChannel + (0 * 256) * 256         midiOutShortMsg mlngHmidi, mlngMidiMsg     End If End Sub   Private Sub getNumberOfDevices()     mlngNumDevices = (midiOutGetNumDevs() - 1) End Sub   Private Sub CurrentDeviceName()     Dim caps    As MIDIOUTCAPS     midiOutGetDevCaps mlngCurDevice, caps, Len(caps)     mstrDeviceName = caps.szPname End Sub   Public Function GetMIDIDevices() As String()     Dim strRet()    As String     Dim lngLoop     As Long     Dim udtCap      As MIDIOUTCAPS          mlngNumDevices = (midiOutGetNumDevs() - 1)     ReDim strRet(0) As String     strRet(0) = " MIDI Mapper"          For lngLoop = 0 To mlngNumDevices         mlngRc = midiOutGetDevCaps(lngLoop, udtCap, Len(udtCap))         ReDim Preserve strRet(lngLoop + 1) As String         strRet(lngLoop + 1) = udtCap.szPname     Next     GetMIDIDevices = strRet() End Function

Thank you for reading this post. Please take time to read the disclaimerabout content found on this site.

Share :

AuthorzaidPosted onMarch 21, 2016CategoriesAll Posts, Excel, VBATagsClasses, Major Scale, MIDI, Music, Music Theory, Musical Scales

SHARE

Oscar perez

Arquitecto especialista en gestion de proyectos si necesitas desarrollar algun proyecto en Bogota contactame en el 3006825874 o visita mi pagina en www.arquitectobogota.tk

• 
• 
• 
• 
•