'CSoundクラスモジュール////////////////////////////////
'//

Option Compare Database  
Option Explicit  

Private Declare Function mciSendCommand Lib "winmm.dll" Alias "mciSendCommandA" _  
    (ByVal wDeviceID As Long, _  
     ByVal uMessage As Long, _  
     ByVal dwParam1 As Long, _  
     dwParam2 As Any) As Long  

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)  
'----------------------------------------------------------------
'定数
Private Const MCI_NOTIFY = &H1&  

Private Const MCI_OPEN = &H803  
    Private Const MCI_OPEN_TYPE = &H2000&  
    Private Const MCI_OPEN_ELEMENT = &H200&  

Private Const MCI_CLOSE = &H804  

Private Const MCI_PLAY = &H806  
    Private Const MCI_FROM = &H4&  
    Private Const MCI_TO = &H8&  

Private Const MCI_PAUSE = &H809  

Private Const MCI_RESUME = &H855  

Private Const MCI_STOP = &H808  

Private Const MCI_SEEK = &H807  
    Private Const MCI_SEEK_TO_START = &H100&  
    Private Const MCI_SEEK_TO_END = &H200&  
    '   Private Const MCI_TO = &H8&

Private Const MCI_SET = &H80D  
    Private Const MCI_SET_TIME_FORMAT = &H400&  
        Private Const MCI_FORMAT_MILLISECONDS = 0  


Private Const MCI_STATUS = &H814  
    Private Const MCI_STATUS_ITEM = &H100&  
    Private Const MCI_STATUS_START = &H200&  
        Private Const MCI_STATUS_LENGTH = &H1&  
        Private Const MCI_STATUS_MODE = &H4&  
        Private Const MCI_STATUS_POSITION = &H2&  

'-------------------------------------------------------------
'構造体
Private Type MCI_OPEN_PARMS  
    dwCallback        As Long  
    wDeviceID         As Long  
    lpstrDeviceType   As String  
    lpstrElementName  As String  
    lpstrAlias        As String  
End Type  

Private Type MCI_PLAY_PARMS  
    dwCallback  As Long  
    dwFrom      As Long  
    dwTo        As Long  
End Type  

Private Type MCI_SEEK_PARMS  
    dwCallback  As Long  
    dwTo        As Long  
End Type  

Private Type MCI_SET_PARMS  
    dwCallback    As Long  
    dwTimeFormat  As Long  
    dwAudio       As Long  
End Type  

Private Type MCI_STATUS_PARMS  
    dwCallback  As Long  
    dwReturn    As Long  
    dwItem      As Long  
    dwTrack     As Integer  
End Type  
'----------------------------------------------------------------
'列挙定数
Public Enum ENUM_DEVTYPE   'デバイスの種類  
    MIDI = 0  
    WAV = 1  
    MP3 = 2  
    AUTO = 3  
End Enum  

Public Enum ENUM_MODE_STATE 'デバイスの状態
    'MCI_STRING_OFFSET = 512  '  if this number is changed you MUST
    MODE_NOT_READY = (512 + 12) '(MCI_STRING_OFFSET + 12)
    MCI_MODE_PAUSE = (512 + 17) '(MCI_STRING_OFFSET + 17) 
    MCI_MODE_PLAY = (512 + 14) '(MCI_STRING_OFFSET + 14) 
    MCI_MODE_STOP = (512 + 13) '(MCI_STRING_OFFSET + 13) 
    MCI_MODE_OPEN = (512 + 18) '(MCI_STRING_OFFSET + 18) 
    MCI_MODE_RECORD = (512 + 15) '(MCI_STRING_OFFSET + 15) 
    MCI_MODE_SEEK = (512 + 16) '(MCI_STRING_OFFSET + 16) 
End Enum 
'----------------------------------------------------------------
'メンバ変数
Private vmtMop As MCI_OPEN_PARMS  


'デストラクタ
Private Sub Class_Terminate()  
    Close_ 
End Sub  

'デバイスOpen
'引数 argsPath : 音楽ファイルのパス  
'     argeType : デバイスの種類(拡張子から自動選択の場合はAUTO)  
'戻値            Open & 初期化成功時 TRUE
Public Function Open_(argsPath As String, _  
                      Optional argeType As ENUM_DEVTYPE = AUTO) As Boolean  
    Dim vvPoint    As Variant  
    Dim vvDevList  As Variant  
    Dim vlRet      As Long  
    Dim vtMsp      As MCI_SET_PARMS  

    '現在のデバイスクローズ
    Close_
    
    'ファイルパスが空文字列の時は終了
    If Len(argsPath) = 0 Then Exit Function  

    'デバイスの種類設定
    vvDevList = Array("Sequencer", "WaveAudio", "MPEGVideo")  

    If argeType = AUTO Then '自動設定
        vvPoint = InStrRev(argsPath, ".", -1, vbBinaryCompare)  

        If IsNull(vvPoint) Or vvPoint = 0 Then  
            vmtMop.lpstrDeviceType = ""  

        Else 
            Select Case Mid(argsPath, vvPoint + 1)  
                Case "Mid"  
                    vmtMop.lpstrDeviceType = vvDevList(0)  
                Case "Wav"  
                    vmtMop.lpstrDeviceType = vvDevList(1)  
                Case "Mp3"  
                    vmtMop.lpstrDeviceType = vvDevList(2)  
                Case Else  
                    vmtMop.lpstrDeviceType = ""  
            End Select  
        End If  

    Else 'デバイス種類が指定されている 

        vmtMop.lpstrDeviceType = vvDevList(argeType)  
    End If  

    'ファイル名設定
    vmtMop.lpstrElementName = argsPath  

    'デバイスOpen
    If mciSendCommand(0, MCI_OPEN, _  
                      MCI_OPEN_TYPE Or MCI_OPEN_ELEMENT, vmtMop) <> 0 Then  
        Exit Function  
    End If  

    '時間単位をミリ秒に設定
    vtMsp.dwTimeFormat = MCI_FORMAT_MILLISECONDS  
    mciSendCommand vmtMop.wDeviceID, MCI_SET, MCI_SET_TIME_FORMAT, vtMsp  

    Open_ = True  
End Function  

'デバイス状態
'戻値 MCI_MODE_NOT_READY, MCI_MODE_PAUSE,  MCI_MODE_PLAY, MCI_MODE_STOP,  
'     MCI_MODE_OPEN,      MCI_MODE_RECORD, MCI_MODE_SEEKまたは0
Public Function Status_() As ENUM_MODE_STATE  
    Dim vtMsp  As MCI_STATUS_PARMS  

    vtMsp.dwItem = MCI_STATUS_MODE  

    If mciSendCommand(vmtMop.wDeviceID, MCI_STATUS, MCI_STATUS_ITEM, vtMsp) <> 0 Then  
        Status_ = 0  
    Else 
        Status_ = vtMsp.dwReturn  
    End If  

End Function  

'現在位置の取得
'戻値 0-1000の範囲で現在位置を返却(失敗時は-1)
Public Function CurrentPosition_() As Long  
    Dim vtMspCur    As MCI_STATUS_PARMS  
    Dim vtMspTotal  As MCI_STATUS_PARMS  

    If Not GetPos(vtMspCur, vtMspTotal) Then  
        CurrentPosition_ = -1: Exit Function  
    End If  

    CurrentPosition_ = vtMspCur.dwReturn / vtMspTotal.dwReturn * 1000  
End Function  

'残り時間取得
'戻値 ミリ秒単位単位で残り演奏時間の返却(失敗時は-1)
Public Function RestMillSec_() As Currency  
    Dim vtMspCur    As MCI_STATUS_PARMS  
    Dim vtMspTotal  As MCI_STATUS_PARMS  

    If Not GetPos(vtMspCur, vtMspTotal) Then  
        RestMillSec_ = -1: Exit Function  
    End If  

    RestMillSec_ = vtMspTotal.dwReturn - vtMspCur.dwReturn  
End Function  

'現在位置とTotal演奏時間の取得
Private Function GetPos(argtMspCur As MCI_STATUS_PARMS, _  
                        argtMspTotal As MCI_STATUS_PARMS) As Boolean  

    '現在の位置をミリ秒単位で取得
    argtMspCur.dwItem = MCI_STATUS_POSITION  
    If mciSendCommand(vmtMop.wDeviceID, MCI_STATUS, MCI_STATUS_ITEM, argtMspCur) <> 0 Then  
        Exit Function  
    End If  

    '全体の長さをミリ秒単位で取得
    argtMspTotal.dwItem = MCI_STATUS_LENGTH  
    If mciSendCommand(vmtMop.wDeviceID, MCI_STATUS, _
                      MCI_STATUS_ITEM, argtMspTotal) <> 0 Then  
        Exit Function  
    End If  

    GetPos = True  
End Function  

'演奏開始
'引数 arglFrom : 演奏開始位置(0-1000)で設定(範囲外は現在位置から演奏) 
'     arglTo   : 演奏終了位置(0-1000)で設定(範囲外は最後まで演奏)  
'戻値 演奏成功時 TRUE
Public Function Play_(Optional arglFrom As Long = -1, _  
                      Optional arglTo As Long = -1) As Boolean  
    Dim vtMsp   As MCI_STATUS_PARMS  
    Dim vtMpp   As MCI_PLAY_PARMS  
    Dim vyFrom  As Boolean  
    Dim vyTo    As Boolean  

    '引数の有効性確認
    vyFrom = IIf(arglFrom < 0 Or arglFrom > 1000, False, True)  
    vyTo = IIf(arglTo < 0 Or arglTo > 1000, False, True)  

    If vyFrom Or vyTo Then 'どちらかの引数が有効の場合
        '全体の長さをミリ秒単位で取得
        vtMsp.dwItem = MCI_STATUS_LENGTH  

        If mciSendCommand(vmtMop.wDeviceID, MCI_STATUS, MCI_STATUS_ITEM, vtMsp) <> 0 Then  
            vyFrom = False: vyTo = False  
        End If  

        '開始位置の特定
        If vyFrom Then vtMpp.dwFrom = vtMsp.dwReturn * arglFrom / 1000  
        '終了位置の特定
        If vyTo Then vtMpp.dwTo = vtMsp.dwReturn * arglTo / 1000  
    End If  

    '演奏開始
    If mciSendCommand(vmtMop.wDeviceID, MCI_PLAY, _  
                      IIf(vyFrom, MCI_FROM, 0) Or IIf(vyTo, MCI_TO, 0), _  
                      vtMpp) <> 0 Then  
        Exit Function  
    End If  

    Play_ = True  
End Function  

'演奏中止
'戻値 演奏中止成功 TRUE
Public Function Stop_() As Boolean  
    If mciSendCommand(vmtMop.wDeviceID, MCI_STOP, 0, ByVal 0) <> 0 Then  
        Exit Function  
    End If  

    If mciSendCommand(vmtMop.wDeviceID, MCI_SEEK, MCI_SEEK_TO_START, ByVal 0) <> 0 Then  
        Exit Function  
    End If  

    Stop_ = True  
End Function  

'デバイスClose (演奏中、一時停止の場合はStopを実行)  
'戻値 Close成功時 TRUE
Public Function Close_() As Boolean  
    Dim vlRet  As Long  

    If Status_ = MCI_MODE_PLAY Or Status_ = MCI_MODE_PAUSE Then  
        Stop_ 
    End If  

    vlRet = mciSendCommand(vmtMop.wDeviceID, MCI_CLOSE, 0, ByVal 0)  
    With vmtMop  
        .dwCallback = 0  
        .lpstrAlias = ""  
        .lpstrDeviceType = ""  
        .lpstrElementName = ""  
        .wDeviceID = 0  
    End With  

    Close_ = Not vlRet  
End Function  

'現在位置の検索移動
'引数 arglPos : 移動する位置を0-1000で設定  
'戻値 移動成功時 TRUE
Public Function Seek_(Optional arglPos As Long = 0) As Boolean  
    Dim vtMstatusp   As MCI_STATUS_PARMS  
    Dim vtMseekp     As MCI_SEEK_PARMS  
    Const clDist     As Long = 200  
    Const clMaxWait  As Long = 5000  
    Dim i            As Long  

    '範囲外のとき
    If arglPos < 0 Or arglPos > 1000 Then Exit Function  

    If arglPos = 0 Then '最初に戻る 
        If mciSendCommand(vmtMop.wDeviceID, MCI_SEEK, MCI_SEEK_TO_START, ByVal 0) <> 0 Then
            Exit Function  
        End If  
    ElseIf arglPos = 1000 Then '最後に移す 
        If mciSendCommand(vmtMop.wDeviceID, MCI_SEEK, MCI_SEEK_TO_END, ByVal 0) <> 0 Then  
            Exit Function  
        End If  
    Else 
        '全体の長さ取得
        vtMstatusp.dwItem = MCI_STATUS_LENGTH  
        If mciSendCommand(vmtMop.wDeviceID, MCI_STATUS, _
                          MCI_STATUS_ITEM, vtMstatusp) <> 0 Then  
            Exit Function  
        End If  

        '移動すべき位置を取得
        vtMseekp.dwTo = vtMstatusp.dwReturn * arglPos / 1000  
        '現在位置を移動
        If mciSendCommand(vmtMop.wDeviceID, MCI_SEEK, MCI_TO, vtMseekp) <> 0 Then  
            Exit Function  
        End If  
    End If  

    'Seek完了までWaitする
    For i = 0 To clMaxWait Step clDist  
        If Status_() <> MCI_MODE_SEEK Then Exit For  
        Sleep clDist  
    Next i  

    Seek_ = IIf(i > clMaxWait, False, True)  
End Function  

'一時停止
'戻値 一時停止成功時 TRUE
Public Function Pause_() As Boolean  
    If Status_ <> MCI_MODE_PLAY Then Exit Function  

    If mciSendCommand(vmtMop.wDeviceID, MCI_PAUSE, 0, ByVal 0) <> 0 Then  
        Exit Function  
    End If  

    Pause_ = True  
End Function  

'再開
'戻値 再開成功時 TRUE
Public Function Resume_() As Boolean  
    If Status_ <> MCI_MODE_PAUSE Then Exit Function  

    If mciSendCommand(vmtMop.wDeviceID, MCI_RESUME, 0, ByVal 0) <> 0 Then  
        Exit Function  
    End If  

    Resume_ = True  
End Function