source: trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/MM/MidiOut.ab@ 594

'#require <api_mmsys.sbp>

Namespace ActiveBasic
Namespace Windows
Namespace MM

'MIDI出力デバイスの種類を表す列挙子
Enum MidiOutDeviceType
    'デバイスはポート
    HardwarePort = 1
    'デバイスはシンセサイザ
    Synthesizer = 2
    'デバイスは方形波シンセサイザ
    SquareWaveSynthesizer = 3
    'デバイスはFMシンセサイザ
    FrequencyModulationSynthesizer = 4
    'デバイスはマッパー
    Mapper = 5
    'デバイスはハードウェアのウェーブテーブルシンセサイザ
    HardwareWavetableSynthesizer = 6
    'デバイスはソフトウェアシンセサイザ
    SoftwareSynthesizer = 7
End Enum


'MIDI出力デバイスの持つ機能を表す列挙子
Enum MidiDeviceFunction
    'デバイスはモノラルの音量調節が可能
    VolumeControl = &H0001
    'デバイスはステレオの音量調節が可能
    LRVolumeControl = &H0002
    'デバイスはキャッシングが可能
    PatchCaching = &H0004
    'デバイスはmidiSteamOut関数を直接サポート
    DirectSupportedMidiStreamOut = &H0008
End Enum

Class MidiOutCaps
    caps As MIDIOUTCAPS

Protected
    Sub _Initialize ( id As DWord )
        midiOutGetDevCaps(id,caps,SizeOf(MIDIOUTCAPS))
    End Sub

Public 'Property
    '製造業者IDの取得
    Function ManufacturerID () As Word
        Return This.caps.wMid
    End Function

    '製品IDの取得
    Function ProductID () As Word
        Return This.caps.wPid
    End Function

    'デバイスドライバのバージョンの取得
    Function DriverVersion () As DWord
        Return This.caps.vDriverVersion
    End Function

    'デバイス名の取得
    Function DeviceName () As String
        Return New System.String(This.caps.szPname As LPTSTR)
    End Function

    'MIDI出力デバイスの種類を取得
    Function DeviceType () As MidiOutDeviceType
        Return This.caps.wTechnology As MidiOutDeviceType
    End Function

    'MIDI出力デバイスがサポートするボイス数を取得
    Function NumberOfVoices () As Word
        Return This.caps.wVoices
    End Function

    'MIDI出力デバイスが同時に演奏することができるノート数
    Function NumberOfNotes () As Word
        Return This.caps.wNotes
    End Function

/*  Function Channel() As Word
        TODO
        This.caps.wChannelMask
    End Function*/

    'デバイスが提供している機能を取得
    Function SupportedFunctions () As MidiDeviceFunction
        Return This.caps.dwSupport As MidiDeviceFunction
    End Function

End Class

'MIDI出力デバイスを扱うためのクラス
Class MidiOutDevice
    id As DWord
    handle As HMIDIOUT

Protected
    Sub _Initialize ( id As DWord )
        This.id = id
    End Sub
    Function Handle () As HMIDIOUT
        Return This.handle
    End Function

Public
    Sub ~MidiOutDevice ()
        This.Close()
    End Sub

Public 'Property
    Function GetCapabilities () As MidiOutCaps
        Return New Detail._System_MidiOutCaps(This.id)
    End Function

Public 'Method
    'デバイスを閉じる
    Sub Close ()
        Dim ret = midiOutClose(InterlockedExchangePointer(ByVal VarPtr(This.handle) As VoidPtr, NULL))
    End Sub

    'デバイスのステレオ音量の左側の値を取得
    Function GetLeftVolume() As Word
        If This.handle=NULL Then Return 0
        Dim volume As DWord
        Dim ret = midiOutGetVolume(This.handle,volume)
        Return LOWORD(volume)
    End Function

    'デバイスのステレオ音量の右側の値を取得
    Function GetRightVolume() As Word
        If This.handle=NULL Then Return 0
        Dim volume As DWord
        Dim ret = midiOutGetVolume(This.handle,volume)
        Return HIWORD(volume)
    End Function

    'デバイスのモノラル音量を取得
    Function GetVolume () As Word
        If This.handle=NULL Then Return 0
        Return This.GetLeftVolume()
    End Function

    'デバイスを開く
    Sub Open ()
        Dim ret = midiOutOpen(This.handle,This.id,0,0,CALLBACK_NULL)
    End Sub

    'コールバックにSystem.Threading.EventWaitHandleを使用してデバイスを開く
    Sub Open ( callback As System.Threading.EventWaitHandle )
        Dim ret = midiOutOpen(This.handle,This.id,callback.Handle() As DWORD_PTR,0,CALLBACK_FUNCTION)
    End Sub

    'コールバックに関数を指定してデバイスを開く
    Sub Open ( callback As MIDICALLBACK )
        Dim ret = midiOutOpen(This.handle,This.id,callback As DWORD_PTR,0,CALLBACK_FUNCTION)
    End Sub

    'コールバックにSystem.Threading.Threadを使用してデバイスを開く
    Sub Open ( callback As System.Threading.Thread )
        Dim ret = midiOutOpen(This.handle,This.id,callback.ThreadId() As DWORD_PTR,0,CALLBACK_THREAD)
    End Sub

    'コールバックにウィンドウハンドルを指定してデバイスを開く
    Sub Open ( callback As HWND )
        Dim ret = midiOutOpen(This.handle,This.id,callback As DWORD_PTR,0,CALLBACK_WINDOW)
    End Sub

    'デバイスの出力を全て停止
    Sub Reset ()
        Dim ret = midiOutReset(This.handle)
    End Sub

    'デバイスにショートメッセージを送信
    Sub SendShortMsg ( msg As DWord )
        If This.handle=NULL Then Exit Sub
        Dim ret = midiOutShortMsg(This.handle,msg)
    End Sub

    'デバイスのステレオ音量の左側の値を設定
    Sub SetLeftVolume ( volume As Word )
        If This.handle=NULL Then Exit Sub
        Dim ret = midiOutSetVolume(This.handle,MAKELONG(volume,This.GetRightVolume()))
    End Sub

    'デバイスのステレオ音量の右側の値を設定
    Sub SetRightVolume ( volume As Word )
        If This.handle=NULL Then Exit Sub
        Dim ret = midiOutSetVolume(This.handle,MAKELONG(This.GetLeftVolume(),volume))
    End Sub

    'デバイスのモノラル音量を設定
    Sub SetVolume ( volume As Word )
        If This.handle=NULL Then Exit Sub
        This.SetLeftVolume(volume)
    End Sub

End Class

Class MidiOut
Public
    'MIDI出力デバイス数を取得
    Static Function NumberOfDevices () As DWord
        Return midiOutGetNumDevs()
    End Function

    'MIDIマッパーを取得
    Static Function GetMIDIMapper () As MidiOutDevice
        Return GetDeviceFromID(MIDI_MAPPER)
    End Function

    'MIDI出力デバイス名を全て取得
    Static Function GetDeviceNames () As System.Collections.Generic.IList<String>
        GetDeviceNames = New System.Collections.Generic.List<String>
        Dim dev = GetDevices()
        Dim d = Nothing As MidiOutDevice
        Foreach d In dev
            GetDeviceNames.Add(d.GetCapabilities().DeviceName())
        Next
    End Function

    'MIDI出力デバイスを全て取得
    Static Function GetDevices () As System.Collections.Generic.IList<MidiOutDevice>
        GetDevices = New System.Collections.Generic.List<MidiOutDevice>
        Dim num = NumberOfDevices
        Dim cnt As DWord
        For cnt=0 To num-1
            GetDevices.Add(GetDeviceFromID(cnt))
        Next
    End Function

    'IDを指定してMIDI出力デバイスを取得
    Static Function GetDeviceFromID ( id As DWord ) As MidiOutDevice
        Return New Detail._System_MidiOutDevice(id)
    End Function
End Class

Namespace Detail
Class _System_MidiOutCaps
    Inherits MidiOutCaps
Public
    Sub _System_MidiOutCaps ( id As DWord )
        This._Initialize(id)
    End Sub

    Override Function ToString () As String
        Return "MidiOutCaps"
    End Function
End Class

Class _System_MidiOutDevice
    Inherits MidiOutDevice
Public
    Sub _System_MidiOutDevice ( id As DWord )
        This._Initialize(id)
    End Sub

    Override Function ToString () As String
        Return "MidiOutDevice"
    End Function
End Class
End Namespace

End Namespace
End Namespace
End Namespace