ホーム > カテゴリ > Visual Basic >

MIDI音源を使用して音を鳴らす

MIDI音源を使用して音を鳴らすサンプルです。

サンプルの実行画面

ソースコード

[MIDI.frm]

'midiOutGetNumDevs＝＞MIDI出力デバイス数を取得する

'<戻り値>
'デバイス数

Private Declare Function midiOutGetNumDevs Lib "winmm" () As Integer


'midiOutOpen＝＞MIDIデバイスを開く

'<引数>
'lphMidiOut：MIDIデバイスのハンドル
'uDeviceID：-1
'dwCallback：0
'dwInstance：0
'dwFlags：0

'<戻り値>
'

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


'midiOutShortMsg＝＞MIDIデバイスから音をだす

'<引数>
'hMidiOut：MIDIデバイスのハンドル
'dwMsg：音階

'<戻り値>
'

Private Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long


'midiOutClose＝＞MIDIデバイスを閉じる

'<引数>
'hMidiOut：MIDIデバイスのハンドル

'<戻り値>
'正常終了0

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

Dim Handle As Long   'MIDIデバイスのハンドル


'音をだす
Private Sub Command1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

 Dim Ret As Long      '戻り値
 Dim Msg As Long      '音階


 Select Case Index
        
        Case 0  'ド
           Msg = &H7F3C90
           Ret = midiOutShortMsg(Handle, Msg)
        Case 1  'レ
           Msg = &H7F3C90 + 2 * 256
           Ret = midiOutShortMsg(Handle, Msg)
        Case 2  'ミ
           Msg = &H7F3C90 + 4 * 256
           Ret = midiOutShortMsg(Handle, Msg)
        Case 3  'ファ
           Msg = &H7F3C90 + 5 * 256
           Ret = midiOutShortMsg(Handle, Msg)
        Case 4  'ソ
           Msg = &H7F3C90 + 7 * 256
           Ret = midiOutShortMsg(Handle, Msg)
        Case 5  'ラ
           Msg = &H7F3C90 + 9 * 256
           Ret = midiOutShortMsg(Handle, Msg)
        Case 6  'シ
           Msg = &H7F3C90 + 11 * 256
           Ret = midiOutShortMsg(Handle, Msg)
        Case 7  'ド
           Msg = &H7F3C90 + 12 * 256
           Ret = midiOutShortMsg(Handle, Msg)

End Select

End Sub

'音を止める
Private Sub Command1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)


 Dim Ret As Long      '戻り値
 Dim Msg As Long      '音階


Select Case Index
      
     Case 0
       Msg = &H3C90
       Ret = midiOutShortMsg(Handle, Msg)
     Case 1
       Msg = &H3C90 + 2 * 256
       Ret = midiOutShortMsg(Handle, Msg)
     Case 2
       Msg = &H3C90 + 4 * 256
       Ret = midiOutShortMsg(Handle, Msg)
     Case 3
       Msg = &H3C90 + 5 * 256
       Ret = midiOutShortMsg(Handle, Msg)
     Case 4
       Msg = &H3C90 + 7 * 256
       Ret = midiOutShortMsg(Handle, Msg)
     Case 5
       Msg = &H3C90 + 9 * 256
       Ret = midiOutShortMsg(Handle, Msg)
     Case 6
       Msg = &H3C90 + 11 * 256
       Ret = midiOutShortMsg(Handle, Msg)
     Case 7
       Msg = &H3C90 + 12 * 256
       Ret = midiOutShortMsg(Handle, Msg)

End Select

End Sub

'音を出す
Private Sub Command2_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim Ret As Long      '戻り値
Dim Msg As Long      '音階

 Select Case Index
        
        Case 0  'ド#
           Msg = &H7F3C90 + 1 * 256
           Ret = midiOutShortMsg(Handle, Msg)
        Case 1  'レ#
           Msg = &H7F3C90 + 3 * 256
           Ret = midiOutShortMsg(Handle, Msg)
        Case 2  'ファ#
           Msg = &H7F3C90 + 6 * 256
           Ret = midiOutShortMsg(Handle, Msg)
        Case 3  'ソ#
           Msg = &H7F3C90 + 8 * 256
           Ret = midiOutShortMsg(Handle, Msg)
        Case 4  'ラ#
           Msg = &H7F3C90 + 10 * 256
           Ret = midiOutShortMsg(Handle, Msg)

End Select

End Sub

'音を止める
Private Sub Command2_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim Ret As Long     '戻り値
Dim Msg As Long     '音階

Select Case Index
      
     Case 0
       Msg = &H3C90 + 1 * 256
       Ret = midiOutShortMsg(Handle, Msg)
     Case 1
       Msg = &H3C90 + 3 * 256
       Ret = midiOutShortMsg(Handle, Msg)
     Case 2
       Msg = &H3C90 + 6 * 256
       Ret = midiOutShortMsg(Handle, Msg)
     Case 3
       Msg = &H3C90 + 8 * 256
       Ret = midiOutShortMsg(Handle, Msg)
     Case 4
       Msg = &H3C90 + 10 * 256
       Ret = midiOutShortMsg(Handle, Msg)

End Select

End Sub


Private Sub Form_Load()

Dim Ret As Long

'MIDI出力デバイス数を取得する
 Ret = midiOutGetNumDevs

If Ret = 0 Then
   
   MsgBox "MIDI音源がないのでこのサンプルはご利用できません。"

Else
 
 'MIDIデバイスを開く
   Ret = midiOutOpen(Handle, -1, 0, 0, 0)

End If
 
 '※MIDIデバイスを開いたら終了時には必ず閉じてください。

End Sub

Private Sub Form_Unload(Cancel As Integer)

Dim Ret As Long

'MIDIデバイスを閉じる
  Ret = midiOutClose(Handle)

End Sub

ソースコード一式のダウンロード

vbapi_midi.zip 1.57 KB (1,617 バイト)

このサンプルの動作環境について

このサンプルは 「Windows98」及び「Microsoft Visual Basic 5.0 Professional Edition」で確認しております。環境が異なる場合は正常に動作しない場合もございますのでご了承下さい。





関連記事


前の記事：音楽CDを再生する
次の記事：MIDI出力デバイス名を列挙する

公開日：2015年03月04日
記事NO：00374