1
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

VBAでMIDIファイルを再生するClass Module Win10 64/32対応 Play Midi File with VBA

Posted at

FormにWindowsMediaPlayerを貼り付ける例はありますが、Declareで宣言する例はないようです。
Midiファイルは標準で入っているtown.midを使用しています。
Midiファイルは2分くらい再生されます。意外に音が大きいかもしれません。
MIDIというと個別のノート再生をする例もあります。将来はそれも考えています。コメントアウトしている部分があるのはそのためです。
ちなみにOutlookで再生しました。

Class モジュール


Option Explicit
'Class name :MidiClass
'2018/12/28
# If Win64 Then
    Private Declare PtrSafe Function midiOutOpen Lib "winmm.dll" (lphMidiOut As LongPtr, ByVal uDeviceID As Long, ByVal dwCallback As LongPtr, ByVal dwInstance As LongPtr, ByVal dwflags As Long) As Long
    Private Declare PtrSafe Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As LongPtr) As Long
    Private Declare PtrSafe Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As LongPtr, ByVal dwMsg As Long) As Long
    Private Declare PtrSafe Function mciExecute Lib "winmm.dll" _
(ByVal lpstrCommand As String) As Long
# Else
    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
    Private Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
    Private Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
    Private Declare Function mciExecute Lib "winmm.dll" _
(ByVal lpstrCommand As String) As Long
# End If
# If Win64 Then
    Private hMidiOut1 As LongLong
# Else
    Private hMidiOut1 As Long
# End If

Private m_bAudio As Boolean
Private mf As String 'Midi File
' 初期化処理
Private Sub Class_Initialize()
m_bAudio = False
mf = ""
End Sub
Public Sub MidiOpen()
    
    MidiClose
    midiOutOpen hMidiOut1, 0, 0, 0, 0
    
End Sub
' 終了時処理
Private Sub Class_Terminate()

Call MidiClose

End Sub

Public Sub MidiClose()

    midiOutClose hMidiOut1
    hMidiOut1 = 0
    
End Sub
Public Sub MidiSetInstrument(ByVal InstrumentID As Long)
    
    If hMidiOut1 = 0 Then MidiOpen
    midiOutShortMsg hMidiOut1, (256 * InstrumentID) + 192
    
End Sub

Public Sub Midi(action As String, MidiFileName As String)
If Dir(MidiFileName) = "" Then
MsgBox MidiFileName & vbCrLf & "Does Not Exist."
Exit Sub
End If
'Call MidiClose
'Call StopMIDI(mf)
mciExecute action & " " & MidiFileName
End Sub

Public Sub PlayMIDI(mf As String)

Midi "play", mf
End Sub

Public Sub StopMIDI(mf As String)
Midi "stop", mf
End Sub
' プロパティプロシージャ
Property Get PlayMidiFileName(getMidifilename As String) As String
  mf = getMidifilename
End Property

標準モジュール


Sub testPlaymidiFile()
Dim clsMIDi As New MidiClass
Set clsMIDi = New MidiClass

clsMIDi.Midi "play", "C:\Windows\Media\town.mid"
End Sub
1
2
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?