'---------------------------------------------------------- '概 要:MID音楽関連 '---------------------------------------------------------- '関数一覧 '機 能:MIDI音楽の連続再生制御 '機 能:MIDI音楽の再生 '機 能:MIDI音楽の終了 '---------------------------------------------------------- '備考 '@効果音を鳴らす ' sndPlaySound LoadResData(103, "CUSTOM"), &H1 Or &H2 Or &H4 '音 ' '---------------------------------------------------------- Option Explicit '---------------------------------------------------------- 'MIDI サウンド再生関連 '---------------------------------------------------------- '@(API) Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hWndCallback As Long) As Long '******************************************************************************************************************** ' 初期化・終了処理 '******************************************************************************************************************** '---------------------------------------------------------- '機 能:MIDI音楽の終了 '説 明:アプリ終了時にも使用 '---------------------------------------------------------- Public Sub COM_Close_Sound() Dim lngExec As Long lngExec = mciSendString("stop Amidifile ", "", 0, 0) lngExec = mciSendString("close Amidifile", "", 0, 0) lngExec = mciSendString("stop Awavefile", "", 0, 0) lngExec = mciSendString("close Awavefile", "", 0, 0) End Sub '******************************************************************************************************************** ' 呼び出し関数 PUBLIC '******************************************************************************************************************** '---------------------------------------------------------- '機 能:MIDI音楽の連続再生制御 '引 数:[T/F]連続再生/一度 '説 明:タイマー上でループ制御を行う '---------------------------------------------------------- Public Sub COM_LoopCheck_Sound(ByVal In_blnBgmloop As Boolean) Dim strMcistaus As String Dim lngChecking As Long On Error GoTo Err_Flag '再生状態取得 strMcistaus = String$(16, " ") lngChecking = mciSendString("status Amidifile mode", strMcistaus, 15, 0) If lngChecking = 263 Then Exit Sub ''@(SUC) '無限ループ再生を行う If (UCase$(Left$(strMcistaus, 7)) = "STOPPED") And In_blnBgmloop = True Then lngChecking = mciSendString("play Amidifile from 0", "", 0, 0) End If Exit Sub Err_Flag: MsgBox Err.Description End Sub '---------------------------------------------------------- '機 能:MIDI音楽の再生 '引 数:[I]再生ファイル名 '説 明: '---------------------------------------------------------- Public Sub COM_PlayMid_Sound(ByVal In_strFileName As String) Dim lngExec As Long On Error GoTo Err_Flag '[ファイル無]音楽を閉じる If In_strFileName = "" Then lngExec = mciSendString("stop Amidifile ", "", 0, 0) lngExec = mciSendString("close Amidifile", "", 0, 0) Debug.Print "MIDI音楽の再生ファイルなし" Exit Sub ''@(SUC) '[ファイル有]音楽を再生 Else '再生 lngExec = mciSendString("stop Amidifile ", "", 0, 0) lngExec = mciSendString("close Amidifile", "", 0, 0) lngExec = mciSendString("open " & Chr(34) & In_strFileName & Chr(34) & " type sequencer alias Amidifile", "", 0, 0) lngExec = mciSendString("play Amidifile from 0", "", 0, 0) End If Exit Sub Err_Flag: MsgBox Err.Description End Sub '---------------------------------------------------------- '機 能:全ての音楽の再生 '引 数:[I]再生ファイル名 '説 明: '---------------------------------------------------------- Public Sub COM_PlayMci_Sound(ByVal In_strFileName As String) Dim lngExec As Long On Error GoTo Err_Flag '[ファイル無]音楽を閉じる If In_strFileName = "" Then lngExec = mciSendString("stop Awavefile", "", 0, 0) lngExec = mciSendString("close Awavefile", "", 0, 0) Debug.Print "音楽の再生ファイルなし" Exit Sub ''@(SUC) '[ファイル有]音楽を再生 Else '再生 lngExec = mciSendString("stop Awavefile", "", 0, 0) lngExec = mciSendString("close Awavefile", "", 0, 0) Call mciSendString("open " & Chr(34) & In_strFileName & Chr(34) & " alias Awavefile", "", 0, 0) Call mciSendString("play Awavefile", "", 0, 0) End If Exit Sub Err_Flag: MsgBox Err.Description End Sub '---------------------------------------------------------- '機 能:WAVE音楽の再生 '引 数:[I]再生ファイル名 '説 明: '---------------------------------------------------------- Public Sub COM_PlayWave_Sound(ByVal In_strFileName As String) Dim sflag%, rc% On Error GoTo Err_Flag sflag% = 3 'SND_NODEFAULT + SND_ASYNC '演奏 rc% = sndPlaySound(In_strFileName, sflag%) Exit Sub Err_Flag: MsgBox Err.Description End Sub