[VBA MIDI]「ショックを受けた時」に流れるクラシック曲

「ショックを受けた時」に
流れるクラシック曲
In “Shocked”
flowing classical music

ベートベン：運命/Symphony No. 5 (Beethoven)
バッハ：トッカータとフーガ/Toccata and Fugue(Bach)
サラサーテ：ツィゴイネルワイゼン/Zigeunerweisen(Sarasate)
グリーグ：ピアノ協奏曲/Piano Concerto (Grieg)
シューマン：ピアノ協奏曲/Piano Concerto (Schumann)
この動画のマクロはWindows11/Office2016で作成してます。

'MIDI API
Private Declare PtrSafe Function midiOutGetNumDevs Lib "winmm" () As Integer
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 midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As LongPtr, ByVal dwMsg As Long) As Long
Private Declare PtrSafe Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As LongPtr) As Long
Dim Handle As LongPtr
'Sleep API
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
Private Declare PtrSafe Function MessageBoxTimeoutA Lib "User32.dll" (ByVal hWnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As VbMsgBoxStyle, ByVal wLanguageID As Long, ByVal dwMilliseconds As Long) As Long
Sub test11()
    MessageBoxTimeoutA 0, "ベートベン：運命/Symphony No. 5 (Beethoven)", "音", 0, 65536, 3000
    Call PlayMsg2("00C0,FF0010,1F:2B:37:43,,,,1F:2B:37:43,,,,1F:2B:37:43,,,,1B:27:33:3F,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,1D:29:35:41,,,,35:41,1D:29,,,,1D:29:35:41,,,,1A:26:32:3E,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,")

    MessageBoxTimeoutA 0, "バッハ：トッカータとフーガ/Toccata and Fugue(Bach)", "音", 0, 65536, 3000
    Call PlayMsg2("10C0,FF0010,45:51,,,,7F4580,7F5180,43:4F,,7F4380,7F4F80,45:51,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,7F4580,7F5180,,,,,,,,,,,,,,,,43:4F,,,,7F4380,7F4F80,41:4D,,,,,7F4180,7F4D80,40:4C,,,,,7F4080,7F4C80,3E:4A,,,,7F3E80,7F4A80,3D:49,,,,,,,,,,,,,,,,,,,,,7F3D80,7F4980,,3E:4A,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,7F3E80,7F4A80,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,39:45,,,,7F3980,7F4580,37:43,,7F3780,7F4380,39:45,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,7F3980,7F4580,,,,,,,,,,,,34:40,,,,,,,,,,7F3480,7F4080,35:41,,,,,,,,,,,7F3580,7F4180,31:3D,,,,,,,,,,7F3180,7F3D80,32:3E,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,7F3280,7F3E80,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,")

    MessageBoxTimeoutA 0, "サラサーテ：ツィゴイネルワイゼン/Zigeunerweisen(Sarasate)", "音", 0, 65536, 3000
    Call PlayMsg2("00C0,FF0015,1F:2B:43,,,,,,,,,,,,,,,,,24:30:48,,,,,,,,,,,,,,,,,26:32:4A,,,,,,,,,,,,,,,,,24:2B:30:3F:4B,,,,,,,,,,,,,,,,,,,2B:30:3C:3F,,,30:43,,2B:3C:3F,,,30:43,,,2B:30:3C:3F,,,30:43,,2B:3C:3F,,,30:43,,,2B:3C:3F,,,2B:30:43,,,2B:30:3C:3F,,,,,30:43,,,,,,4A,29:2C:32:3E,,,,,,,,,,,,,,,,,,,,,,,,,24:48,,26,4A,,27:4B,,26:4A,,,24:2C:30:3C:48,,,,,,,,,,,,,,,,,,,,23:2F:3B:47,,,,,,,,,24:30:3C:48,,,,,,,,,,,,,,,,,,,,2B:3C:3F,,30:43,,,2B:3C:3F,,,30:43,,,2B:3C:3F,,30:43,,,2B:3C:3F,,,30:43,,2B:3C,3F,,30:43,,,2B:3C:3F,,,,30:43,,,,37:3C:3F,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,")

    MessageBoxTimeoutA 0, "グリーグ：ピアノ協奏曲/Piano Concerto (Grieg)", "音", 0, 65536, 3000
    Call PlayMsg2("00C0,FF0015,51:54:58:5D,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,45:51:5D,,,,,,5C:68,44:50,,,,,,40:44:47:4C:58:5C:5F:64,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,40:4C:58:64,,,,,,3C:48:54:60,,,,,,,39:3C:40:45:51:54:58:5D,,,,,,,,,,39:45:51:5D,,,,,38:44:50:5C,,,,,,34:38:3B:40:4C:50:53:58,,,,,,,,,,34:40:4C:58,,,,,30:3C:48:4C:54,,,,,,,2D:30:34:39:45:48:4C:51,,,,,,,,,,,2D:39:45:51,,,,,,,2C:38:44:50,,,,,,,28:2F:34:40:44:47:4C,,,,,,,,,,,,28:34:40:44:4C,,,,,,,,24:30:3C:48,,,,,,,,,,,21:2D:39:45,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,")

    MessageBoxTimeoutA 0, "シューマン：ピアノ協奏曲/Piano Concerto (Schumann)", "音", 0, 65536, 3000
    Call PlayMsg2("00C0,FF0010,28:34:44:47:4C,,,,,,,,,,44:48:4C:50:54:58,,,45:48:4D:51:54:59,,,,,,,,,,,,,,,,39:40:45:49:4C:51:55,,,41:45:4A:4D:56,,,,,,,,3D:41:45:49:4D:51:55,,3A:3E:41:46:4A:4D:52,,,,,,,3B:40:44:47:4C:50,,,3C:40:45:48:4C:51,,,,,,,38:3C:40:44:48:4C,,,39:3C:41:45:48:4D,,,,,,,34:39:3D:40:45:49,,,35:39:41:45:4A,,,,,,,31:35:39:3D:45,,32:35:3A:3E:46,,,,,,,,2F:34:38:3B:40:44,,,30:34:39:40:45,,,,,,,,26:32:39:3E:41,,,28:30:34:39:3C:40,,,,,,,,,,,,,28:34:44:47:4A:4C:50,,,,,,,,,,,,,,,,21:2D:34:3C:45:48:4C:51,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,")
End Sub
Public Function PlayMsg2(msg_dat)
    Dim Msg As Long
    'MIDI出力デバイス取得
    Dim Ret As Long
    Ret = midiOutGetNumDevs
    'MIDIデバイスを開く
    If Ret = 0 Then
        Debug.Print "MIDI音源が無いため利用できません。"
        Exit Function
    End If
    Ret = midiOutOpen(Handle, -1, 0, 0, 0)
    arr_dat = Split(msg_dat, ",")
    Call midiOutShortMsg(Handle, "&H" & Mid(arr_dat(0), 1, 2) & "C0")
    sleep_time = 50
    For i = 0 To UBound(arr_dat)
        If Len(arr_dat(i)) Then
            If InStr(arr_dat(i), ":") + (Sgn(Len(arr_dat(i)) - 2) - 1) Then
                If Len(arr_dat(i)) Then
                    arr_dat2 = Split(arr_dat(i), ":")
                    For j = 0 To UBound(arr_dat2)
                        Msg = Val("&H7F" & arr_dat2(j) & "90")
                        'Debug.Print Hex(Msg)
                        Call midiOutShortMsg(Handle, Msg)
                    Next
                End If
                Sleep (sleep_time)
            Else
                If Mid(arr_dat(i), 1, 2) = "FF" Then
                    sleep_time = Val("&H" + Mid(arr_dat(i), 3))
                Else
                    Call midiOutShortMsg(Handle, "&H" & arr_dat(i))
                End If
            End If
        Else
                Sleep (sleep_time)
        End If
        DoEvents
    Next
    'MIDIデバイスを閉じる
    Ret = midiOutClose(Handle)
End Function

コメントを残す コメントをキャンセル

コメントを残すコメントをキャンセル