VBのお部屋 - エクスクルーシブ・メッセージの送信

　MCIなどを使えば簡単にMIDIプレイヤーを作ることができます。しかし、演奏前にプレイヤー側から音源を初期化するにはどうすればいいのでしょう。もっとも簡単な方法は初期化用のファイルを用意しておいて、それを演奏すればいいのです。しかしこの方法では別途ファイルを用意する必要があります。そこで、Win32API関数を用いて音源に初期化のエクスクルーシブメッセージを送信したいとおもいます。　

　ここでは例としてGMシステム・オンを送信することにします。

Private Const MAXPNAMELEN = 32
Private Const MIDIMAPPER = -1

Type MIDIHDR
　　lpData As Long
　　dwBufferLength As Long
　　dwBytesRecorded As Long
　　dwUser As Long
　　dwFlags As Long
　　lpNext As Long
　　Reserved As Long
　　dwOffset As Long
　　Rev(3) As Long
End Type

'MIDI出力ﾎﾟｰﾄをｵｰﾌﾟﾝするAPI
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

'MIDI出力ﾎﾟｰﾄをｸﾛｰｽﾞするAPI
Private Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long

Private Declare Function midiOutLongMsg Lib "winmm.dll" (ByVal hMidiOut As Long, lpMidiOutHdr As MIDIHDR, ByVal uSize As Long) As Long

'MIDI出力をﾘｾｯﾄするAPI
Private Declare Function midiOutReset Lib "winmm.dll" (ByVal hMidiOut As Long) As Long

Private Declare Function midiOutPrepareHeader Lib "winmm.dll" (ByVal hMidiOut As Long, lpMidiOutHdr As MIDIHDR, ByVal uSize As Long) As Long
Private Declare Function midiOutUnprepareHeader Lib "winmm.dll" (ByVal hMidiOut As Long, lpMidiOutHdr As MIDIHDR, ByVal uSize As Long) As Long

Public Sub MidiReset(hWnd As Long)
' hWnd アプリケーションのウィンドウハンドル

　　Dim hMIDI As Long
　　Dim MIDI_HDR As MIDIHDR
　　Dim Execlusive() As Byte
　　Dim lngRC As Long

　　'エクスクルーシブ・メッセージの設定（ＧＭシステム・オン）
　　ReDim Execlusive(5)
　　Execlusive(0) = &HF0
　　Execlusive(1) = &H7E
　　Execlusive(2) = &H7F
　　Execlusive(3) = &H9
　　Execlusive(4) = &H1
　　Execlusive(5) = &HF7

　　'MIDIデバイスを開く（開くデバイスはMIDI MAPPER）
　　If midiOutOpen(hMIDI, MIDIMAPPER, hWnd, 0, &H10000) Then Exit Sub

　　With MIDI_HDR
　　　　.lpData = VarPtr(Execlusive(0))
　　　　.dwBufferLength = UBound(Execlusive) + 1
　　　　.dwBytesRecorded = 0
　　　　.dwUser = 0
　　　　.lpNext = 0
　　　　.dwFlags = 0
　　End With

　　lngRC = midiOutPrepareHeader(hMIDI, MIDI_HDR, LenB(MIDI_HDR))

　　'送信
　　lngRC = midiOutLongMsg(hMIDI, MIDI_HDR, LenB(MIDI_HDR))

　　DoEvents

　　'念のためリセットする
　　Call midiOutReset(hMIDI)

　　'閉じる
　　lngRC = midiOutUnprepareHeader(hMIDI, MIDI_HDR, LenB(MIDI_HDR))
　　lngRC = midiOutClose(hMIDI)
End Sub

他のエクスクルーシブ・メッセージを送信したい場合はバイト配列Execlusiveを変更すればいいです。