MIDI-Monitor Programming-SourceCode for Visual Basic

Imports System.Threading
Imports System.Runtime.InteropServices

Public Class Form1

    Public Declare Function midiInGetNumDevs Lib "winmm.dll" () As Integer
    Public Declare Function midiInGetDevCaps Lib "winmm.dll" Alias "midiInGetDevCapsA" (ByVal uDeviceID As Integer, ByRef lpCaps As MIDIINCAPS, ByVal uSize As Integer) As Integer
    Public Declare Function midiInOpen Lib "winmm.dll" (ByRef hMidiIn As Integer, ByVal uDeviceID As Integer, ByVal dwCallback As MidiInCallback, ByVal dwInstance As Integer, ByVal dwFlags As Integer) As Integer
    Public Declare Function midiInStart Lib "winmm.dll" (ByVal hMidiIn As Integer) As Integer
    Public Declare Function midiInStop Lib "winmm.dll" (ByVal hMidiIn As Integer) As Integer
    Public Declare Function midiInReset Lib "winmm.dll" (ByVal hMidiIn As Integer) As Integer
    Public Declare Function midiInClose Lib "winmm.dll" (ByVal hMidiIn As Integer) As Integer

    Public Delegate Function MidiInCallback(ByVal hMidiIn As Integer, ByVal wMsg As UInteger, ByVal dwInstance As Integer, ByVal dwParam1 As Integer, ByVal dwParam2 As Integer) As Integer
    Public ptrCallback As New MidiInCallback(AddressOf MidiInProc)
    Public Const CALLBACK_FUNCTION As Integer = &H30000
    Public Const MIDI_IO_STATUS = &H20

    Public Delegate Sub DisplayDataDelegate(dwParam1)

    Public Structure MIDIINCAPS
        Dim wMid As Int16 ' Manufacturer ID
        Dim wPid As Int16 ' Product ID
        Dim vDriverVersion As Integer ' Driver version
         Dim szPname As String ' Product Name
        Dim dwSupport As Integer ' Reserved
    End Structure

    Dim hMidiIn As Integer
    Dim StatusByte As Byte
    Dim DataByte1 As Byte
    Dim DataByte2 As Byte
    Dim MonitorActive As Boolean = False
    Dim HideMidiSysMessages As Boolean = False

    Function MidiInProc(ByVal hMidiIn As Integer, ByVal wMsg As UInteger, ByVal dwInstance As Integer, ByVal dwParam1 As Integer, ByVal dwParam2 As Integer) As Integer
        If MonitorActive = True Then
            TextBox1.Invoke(New DisplayDataDelegate(AddressOf DisplayData), New Object() {dwParam1})
        End If
    End Function

    Private Sub DisplayData(dwParam1)
        If ((HideMidiSysMessages = True) And ((dwParam1 And &HF0) = &HF0)) Then
            Exit Sub
        Else
            StatusByte = (dwParam1 And &HFF)
            DataByte1 = (dwParam1 And &HFF00) >> 8
            DataByte2 = (dwParam1 And &HFF0000) >> 16
            TextBox1.AppendText(String.Format("{0:X2} {1:X2} {2:X2}{3}", StatusByte, DataByte1, DataByte2, vbCrLf))
        End If
    End Sub

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        Me.Show()
        If midiInGetNumDevs() = 0 Then
            MsgBox("No MIDI devices connected")
            Application.Exit()
        End If

        Dim InCaps As New MIDIINCAPS
        Dim DevCnt As Integer

        For DevCnt = 0 To (midiInGetNumDevs - 1)
            midiInGetDevCaps(DevCnt, InCaps, Len(InCaps))
            ComboBox1.Items.Add(InCaps.szPname)
        Next DevCnt
    End Sub

    Private Sub ComboBox1_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles ComboBox1.SelectedIndexChanged
        ComboBox1.Enabled = False
        Dim DeviceID As Integer = ComboBox1.SelectedIndex
        midiInOpen(hMidiIn, DeviceID, ptrCallback, 0, CALLBACK_FUNCTION Or MIDI_IO_STATUS)
        midiInStart(hMidiIn)
        MonitorActive = True
        Button2.Text = "Stop monitor"
    End Sub

    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        TextBox1.Clear()
    End Sub

    Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
        If MonitorActive = False Then
            midiInStart(hMidiIn)
            MonitorActive = True
            Button2.Text = "Stop monitor"
        Else
            midiInStop(hMidiIn)
            MonitorActive = False
            Button2.Text = "Start monitor"
        End If
    End Sub

    Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
        If HideMidiSysMessages = False Then
            HideMidiSysMessages = True
            Button3.Text = "Show System messages"
        Else
            HideMidiSysMessages = False
            Button3.Text = "Hide System messages"
        End If
    End Sub

    Private Sub Form1_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
        MonitorActive = False
        midiInStop(hMidiIn)
        midiInReset(hMidiIn)
        'midiInClose(hMidiIn)
        Application.Exit()
    End Sub

End Class