VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Sound"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private strFileName As String 'Recives the FileName
Private blnWait As Boolean ' Determines if VB should wait until play
Private lngVolume As Long 'Determines the Volume value
Private blnMute As Boolean 'Determines if you want mute the sound or not
Private strShorFileName As String

Const MAX_PATH As Long = 260

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

Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long

Public Sub FileOpen(ByVal FileName As String)
    Dim nReturn As Long
    If ValidFile(FileName) = False Then Exit Sub
    strFileName = FileName
    strShorFileName = GetShortFileName(strFileName)
    nReturn = mciSendString("Open " & strShorFileName & " wait", "", 0, 0)
    nReturn = mciSendString("setaudio " & strFileName & " volume to " & (lngVolume * 10), "", 0, 0)
End Sub

Public Sub FileClose()
    Dim nReturn As Long
    If strFileName = "" Then Exit Sub
    nReturn = mciSendString("Close " & strShorFileName, "", 0, 0)
    strFileName = ""
End Sub

Public Sub SoundPause()
    Dim nReturn As Long
    If strFileName = "" Then Exit Sub
    nReturn = mciSendString("Pause " & strShorFileName, "", 0, 0)
End Sub

Public Sub SoundResume()
    Dim nReturn As Long
    If strFileName = "" Then Exit Sub
    nReturn = mciSendString("Resume " & strShorFileName, "", 0, 0)
End Sub

Public Sub SoundPlay()
    Dim lngReturn As Long
    If strFileName = "" Then Exit Sub
    If blnMute = False Then lngReturn = mciSendString("setaudio " & strShorFileName & " volume to " & (Volume * 10), "", 0, 0)
    lngReturn = mciSendString("Seek " & strShorFileName & " to " & 0&, "", 0, 0)
    
    If blnWait = True Then
        lngReturn = mciSendString("Play " & strShorFileName & " wait", 0&, 0, 0)
    Else
        lngReturn = mciSendString("Play " & strShorFileName, 0&, 0, 0)
    End If
End Sub

Public Sub SoundStop()
    Dim nReturn As Long
    If strFileName = "" Then Exit Sub
    nReturn = mciSendString("Seek " & strShorFileName & " to " & 0&, "", 0, 0)
    nReturn = mciSendString("Stop " & strShorFileName, "", 0, 0)
End Sub

Public Sub SoundStart(ByVal Start As Single, Optional Finish As Single = 0)
    Dim nReturn As Long
    If blnMute = False Then nReturn = mciSendString("setaudio " & strShorFileName & " volume to " & (Volume * 10), "", 0, 0)
    If Finish = 0 Then
        nReturn = mciSendString("play " & strShorFileName & " from " & Start & " to " & Length, "", 0, 0)
    Else
        nReturn = mciSendString("play " & strShorFileName & " from " & Start & " to " & Finish, "", 0, 0)
    End If
End Sub

Property Get FileName() As String
    FileName = strFileName
End Property

Property Let FileName(ByVal FileName As String)
    If ValidFile(FileName) = False Then Exit Property
    FileOpen FileName
End Property

Property Get Wait() As Boolean
    Wait = blnWait
End Property

Property Let Wait(WaitValue As Boolean)
    blnWait = WaitValue
End Property

Property Get Length() As Single
    Dim nReturn As Long, nLength As Integer
    Dim sLength As String * 255
    
    If strFileName = "" Then
        Length = 0
        Exit Property
    End If
    
    nReturn = mciSendString("Status " & strShorFileName & " length", sLength, 255, 0)

    nLength = InStr(sLength, Chr$(0))

    Length = Val(Left$(sLength, nLength - 1))

End Property

Property Let Position(ByVal nPosition As Single)
    Call SoundStart(nPosition)
End Property

Property Get Position() As Single
    Dim nReturn As Integer, nLength As Integer

    Dim sPosition As String * 255

    If strFileName = "" Then Exit Property
    nReturn = mciSendString("Status " & strShorFileName & " position", sPosition, 255, 0)
    nLength = InStr(sPosition, Chr$(0))
    Position = Val(Left$(sPosition, nLength - 1))
End Property

Property Get Status() As String
    Dim nReturn As Integer, nLength As Integer
    Dim sStatus As String * 255
    If strFileName = "" Then Exit Property
    nReturn = mciSendString("Status " & strShorFileName & " mode", sStatus, 255, 0)
    nLength = InStr(sStatus, Chr$(0))
    Status = Left$(sStatus, nLength - 1)
End Property

Private Sub Class_Initialize()
    blnMute = False
    lngVolume = 50
    blnWait = False
End Sub

Private Sub Class_Terminate()
    If Status <> "stopped" Then Call SoundStop
    Call FileClose
End Sub

Private Function ValidFile(FileName As String) As Boolean
    FileName = LCase(FileName)
    If (FileName Like "*.wave" = True Or FileName Like "*.wav") Then
        ValidFile = True
    ElseIf FileName Like "*.wma" = True Then
        ValidFile = True
    ElseIf FileName Like "*.cda" = True Then
        ValidFile = True
    ElseIf FileName Like "*.mp3" = True Then
        ValidFile = True
    ElseIf FileName Like "*.mid" = True Then
        ValidFile = True
    Else
        ValidFile = False
    End If
End Function

Property Let Volume(Volume As Long)
    Dim lngResult As Long
    If blnMute = False Then
        lngResult = mciSendString("setaudio " & strShorFileName & " volume to " & (Volume * 10), "", 0, 0)
    Else
        lngResult = mciSendString("setaudio " & strShorFileName & " volume to " & 0, "", 0, 0)
    End If
    lngVolume = Volume
End Property

Property Get Volume() As Long
    Volume = lngVolume
End Property

Property Get Mute() As Boolean
    Mute = blnMute
End Property

Property Let Mute(Mute As Boolean)
    Dim lngResult As Long
    blnMute = Mute
    If Mute = True Then
        lngResult = mciSendString("setaudio " & strShorFileName & " volume to " & 0, "", 0, 0)
    Else
        lngResult = mciSendString("setaudio " & strShorFileName & " volume to " & (lngVolume * 10), "", 0, 0)
    End If
End Property

Property Get Time(Milliseconds As Long) As String
    Dim h As Long, hh As String
    Dim m As Long, mm As String
    Dim s As Long, ss As String
  
    s = Milliseconds \ 1000
    m = s \ 60
    h = m \ 60
    s = s Mod 60
    m = m Mod 60
    hh = Format(h, "00:")
    mm = Format(m, "00:")
    ss = Format(s, "00")
    Time = hh & mm & ss
End Property

Private Function GetShortFileName(ByVal sFileName As String) As String
    Dim sBuffer As String
    sBuffer = String$(MAX_PATH, vbNullChar)
    Call GetShortPathName(sFileName, sBuffer, MAX_PATH)
    GetShortFileName = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
End Function