投稿者 るきお  (社会人) 投稿日時 2008/10/1 06:53:51
ドレミファソラシドだとこんな感じで演奏できます。
少しアドリブ入れてます。
Midi音源がないとエラーになります。

   
Private Declare Sub midiOutOpen Lib "winmm.dll" (ByRef lphmo As IntegerByVal uDeviceID As IntegerByVal dwCallback As IntegerByVal dwCallbackInstance As IntegerByVal dwFlags As Integer)
    Private Declare Sub midiOutShortMsg Lib "winmm.dll" (ByVal hmo As IntegerByVal 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.ObjectByVal 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 IntegerByVal 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 IntegerByVal Data1 As IntegerByVal Data2 As IntegerAs Integer

        Return Stat Or (Data1 << 8) Or (Data2 << 16)

    End Function