Playing MIDI

Another Member suggested that I post this example in the codebank. The bare essentials to playing MIDI in a project. It plays chords in the key of C Major. Left Mouse button staccato - right mouse button legato

You'll need 1 form with a combobox and 1 button with the index set to zero:

Code:

---

Option Explicit

'Name length Constant
Const MAXPNAMELEN = 32

'Midi Note format
Const KeyOn = &H90 'Simulates Key Press

Const KeyOff = &H80 'Simulates Key Release

Private Type MidiMsg
    status As Byte  'Key On or Off
    Note As Byte    'Note - 60 is middle C each increment is a half step
    Velocity As Byte 'Simulates how hard key was struck 0 - 127
    Data3 As Byte  'Not used in this example
End Type

'Holds in formation about device (Port)
Private Type MIDIOUTCAPS
        wMid As Integer
        wPid As Integer
        vDriverVersion As Long
        szPname As String * MAXPNAMELEN
        wTechnology As Integer
        wVoices As Integer
        wNotes As Integer
        wChannelMask As Integer
        dwSupport As Long
End Type

'Callback routed to form - not used but necessary
Private Const CALLBACK_WINDOW = &H10000

'Send note to Midi Device (Port)
Private Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long

'Close Port
Private Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long

'Open a specific Midi Port
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

'Get how Many Ports are available
Private Declare Function midiOutGetNumDevs Lib "winmm" () As Integer

'Get info from specific port
Private Declare Function midiOutGetDevCaps Lib "winmm.dll" Alias "midiOutGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As MIDIOUTCAPS, ByVal uSize As Long) As Long

'Used to convert Note Message to an unsigned Long Integer for API compatibility
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)



Dim hMidi As Long ' Holds Midi Port Handle to reference aspecific opened port
Private Sub Combo1_Click()
'Close any open ports
midiOutClose hMidi
'Open Port indicated in Combo Box
midiOutOpen hMidi, Combo1.ListIndex, Me.hWnd, 0, CALLBACK_WINDOW
End Sub
Private Sub Command1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim msg As MidiMsg, ml As Long
'set up note info
msg.status = KeyOn
msg.Velocity = 64
msg.Data3 = 0

'choose note accroding to key pressed
msg.Note = Choose(Index + 1, 60, 62, 64, 65, 67, 69, 71)
CopyMemory ml, msg, 4 'copy to unsigned long integer
midiOutShortMsg hMidi, ml 'send note

'send next note
msg.Note = Choose(Index + 1, 64, 65, 67, 69, 71, 72, 74)
CopyMemory ml, msg, 4
midiOutShortMsg hMidi, ml

'send third note in triad
msg.Note = Choose(Index + 1, 67, 69, 71, 72, 74, 76, 77)
CopyMemory ml, msg, 4
midiOutShortMsg hMidi, ml

End Sub

Private Sub Command1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim msg As MidiMsg, ml As Long

'if Right mouse button pressed, sustain note
If Button = 2 Then Exit Sub
'set up note off
msg.status = KeyOff
msg.Velocity = 64
msg.Data3 = 0

'shut off first note
msg.Note = Choose(Index + 1, 60, 62, 64, 65, 67, 69, 71)
CopyMemory ml, msg, 4
midiOutShortMsg hMidi, ml

'shut off next note
msg.Note = Choose(Index + 1, 64, 65, 67, 69, 71, 72, 74)
CopyMemory ml, msg, 4
midiOutShortMsg hMidi, ml

'shut off last note in triad
msg.Note = Choose(Index + 1, 67, 69, 71, 72, 74, 76, 77)
CopyMemory ml, msg, 4
midiOutShortMsg hMidi, ml

End Sub

Private Sub Form_Load()
Dim i As Long, caps As MIDIOUTCAPS

Me.ScaleMode = vbPixels
Me.Caption = "Diatonic Chords,Mouse Button: Left-Staccato, Right-Legato"
Combo1.Left = 0
Combo1.Top = 0

'Get number of devices and load names into combo box
For i = 0 To midiOutGetNumDevs() - 1
    midiOutGetDevCaps i, caps, Len(caps)
    Combo1.AddItem caps.szPname, i
Next
Combo1.ListIndex = 0

For i = 0 To 6
   
    Command1(0).Width = Me.ScaleWidth / 7
    If i > 0 Then Load Command1(i)
    With Command1(i)
        .Left = Me.ScaleWidth / 7 * i
        .Visible = True
        .Top = Me.ScaleHeight / 2 - .Height / 2
        .Caption = Choose(i + 1, "C", "Dm", "Em", "F", "G", "Am", "B")
    End With
Next

End Sub

Private Sub Form_Unload(Cancel As Integer)
'Close Port
midiOutClose hMidi
End Sub

---