Private Declare Sub midiOutOpen Lib "winmm.dll" (ByRef lphmo As Integer, ByVal uDeviceID As Integer, ByVal dwCallback As Integer, ByVal dwCallbackInstance As Integer, ByVal dwFlags As Integer) Private Declare Sub midiOutShortMsg Lib "winmm.dll" (ByVal hmo As Integer, ByVal dwMsg As Integer) Private Declare Sub midiOutClose Lib "winmm.dll" (ByVal hmo As Integer) Private Const MIDI_MAPPER As Integer = -1 Private hMidiOut As Integer Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click midiOutOpen(hMidiOut, MIDI_MAPPER, 0, 0, 0) Play(49) '弦楽器合奏で演奏 Play(58) 'トランペットで演奏 Play(79) 'オカリナで演奏 midiOutClose(hMidiOut) End Sub '''<summary>メロディを奏でる</summary> ''' <param name="Instrument">音色</param> Protected Overloads Sub Play(ByVal Instrument As Integer) Dim length As Integer = 500 midiOutShortMsg(hMidiOut, MidiMsg(&HC0, Instrument, &H0)) PlayNote(length, &H3C) PlayNote(length \ 2, &H3E) PlayNote(length \ 2, &H40) PlayNote(length, &H41) PlayNote(length, &H43) PlayNote(length \ 2, &H45 + 12) PlayNote(length \ 2, &H45) PlayNote(length \ 2, &H47 + 12) PlayNote(length \ 2, &H47) PlayNote(length * 2, &H3C + 12) End Sub ''' <summary>音を1音鳴らす</summary> ''' <param name="length">音の長さ。500で四分音符くらい。</param> ''' <param name="key">音階。&H3Cで中央のド。</param> Private Function PlayNote(ByVal length As Integer, ByVal key As Integer) midiOutShortMsg(hMidiOut, MidiMsg(&H90, key, &H7F)) Threading.Thread.Sleep(length) midiOutShortMsg(hMidiOut, MidiMsg(&H90, key, 0)) End Function 'チャンネル, ノート, ベロシティ Private Shared Function MidiMsg(ByVal Stat As Integer, ByVal Data1 As Integer, ByVal Data2 As Integer) As Integer Return Stat Or (Data1 << 8) Or (Data2 << 16) End Function