エクスクルーシブ・メッセージの送信


 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

  'エクスクルーシブ・メッセージの設定(GMシステム・オン)
  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を変更すればいいです。

戻る