control volume level

[moti barski]

how do i control the volume level that the speakers output ?

i found http://www.codeproject.com/KB/audio-video/AudioLib.aspx
BUT, it is for c# perhapse someone can convert it to vb.net

[namrekka]

I jump back to this thread because a lot of questions is about controlling the volume of the master output. Microsoft changed a lot about this from Vista and higher. In XP you could use the "waveOutSetVolume" API. In Vista and higher this will only set the volume of the application you use the API in.

http://msdn.microsoft.com/en-us/library/ms678705.aspx

In Vista and higher they work with "endpoint devices". I found some code but didn't test it yet. It is more then just a API call...............

http://www.planet-source-code.com/vb...73680&lngWId=1

http://www.codeproject.com/KB/vista/CoreAudio.aspx

[MarMan]

I go here for my conversions.

[moti barski]

would this work on win 7 ?

Option Strict Off
Option Explicit On 
Friend Class MP3Class
    '
    Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Integer, ByVal hwndCallback As Integer) As Integer
    Public Declare Function auxGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal lpdwVolume As Long) As Long
    Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Integer) As Integer
    Public MP3File As String
    Dim TheFile As String
    Dim movieBox As PictureBox
    Public retVal As Integer ' used to store our return value from the mci interface
    Private retData As String = Space$(128) ' used to store our return data from various commands
    Private _volLevel As Integer = Nothing
    Private _dMS As Integer = Nothing
    Private _dSec As Integer = Nothing
    Private _fDur As String = Nothing
    Private _posMS As Integer = Nothing
    Private _posSec As Integer = Nothing
    Private _fPos As String = Nothing
    Private _rChanValue As Boolean = False
    Private _lChanValue As Boolean = False
    Private _tRemainingMS As Integer = Nothing
    Private _tRemainingSec As Integer = Nothing
    Private _fTRemaining As String = Nothing
    Private _muteOutput As Boolean = False

    Public Function MP3Playing() As Boolean
        On Error GoTo TheError
        Static s As New Integer()
        mciSendString("status " & TheFile & " mode", s.Equals(30), Len(s.Equals(30)), 0)
        MP3Playing = (Mid(s.Equals(30), 1, 7) = "playing")
        Exit Function
TheError: MsgBox(Err.Description, , " Error")
    End Function
    Public Function MP3SavePlayList(ByRef TheFile As String, ByRef playlist As ListBox) As Object
        On Error GoTo TheError
        Dim i As Short
        Dim a As String
        FileOpen(1, TheFile, OpenMode.Output)
        For i = 0 To playlist.Items.Count - 1
            a = playlist.Items(i)
            PrintLine(1, a)
        Next
        FileClose(1)
        Exit Function
TheError: MsgBox(Err.Description, , " Error")
    End Function

    Public Function MP3OpenPlayList(ByRef TheFile As String, ByRef playlist As ListBox) As Object
        On Error GoTo TheError
        Dim test As String
        If TheFile = "" Then Exit Function
        FileOpen(1, TheFile, OpenMode.Input)
        While Not EOF(1)
            test = LineInput(1)
            playlist.Items.Add(RTrim(test))
        End While
        FileClose(1)
        Exit Function
TheError: MsgBox(Err.Description, , " Error")
    End Function
    Public Function GetLastBackSlash(ByRef text As String) As String
        On Error GoTo TheError
        Dim i As Object
        Dim pos As Short
        Dim lastslash As Short


        For i = 1 To Len(text)

            pos = InStr(i, text, "\", CompareMethod.Text)
            If pos <> 0 Then lastslash = pos
        Next i
        GetLastBackSlash = Right(text, Len(text) - lastslash)
        Exit Function
TheError: MsgBox(Err.Description, , " Error")
    End Function

    'Take the path and .mp3 off the file
    Public Sub ListNoChar(ByRef playlist As System.Windows.Forms.ListBox, ByVal playlistPath As System.Windows.Forms.ListBox)
        On Error GoTo TheError
        Dim X As Object
        Dim NoChar As String
        Dim NoEnd As String

        For X = 0 To playlistPath.Items.Count - 1

            NoChar = GetLastBackSlash(playlistPath.Items(X))
            NoEnd = RightLeft(NoChar, ".")
            'NoEnd = Mid(NoChar, 1, 1)
            playlist.Items.Add(playlist.Items.Count + 1 & ".  " & NoEnd)
        Next X
        Exit Sub
TheError: MsgBox(Err.Description, , " Error")
    End Sub

    Function GetFileExtension(ByVal strFileName As String) As String
        Dim lngPosition As Long

        lngPosition = InStrRev(strFileName, ".")
        If lngPosition Then
            GetFileExtension = Mid$(strFileName, lngPosition + 1)
        End If
    End Function

    Public Function RightLeft(ByRef source As String, ByRef token As String) As String
        On Error GoTo TheError
        Dim i As Short
        RightLeft = ""
        '
        For i = Len(source) To 1 Step -1
            '
            If Mid(source, i, 1) = token Then
                RightLeft = Left(source, i - 1)
                Exit Function
            End If
        Next i
        Exit Function
TheError: MsgBox(Err.Description, , " Error")

    End Function
    Private Function NoEndChar(ByRef playlistPath As System.Windows.Forms.ListBox) As String
        On Error GoTo TheError
        Dim N As Object
        For N = 0 To playlistPath.Items.Count - 1

        Next N
        Exit Function
TheError: MsgBox(Err.Description, , " Error")
    End Function

    Sub MP3Play()
        mciSendString("close " & TheFile, CStr(0), 0, 0)
        TheFile = Chr(34) & Trim(MP3File) & Chr(34)
        mciSendString("open " & TheFile, CStr(0), 0, 0)
        mciSendString("play " & TheFile, "", 0, 0)
        Exit Sub
TheError: MsgBox(Err.Description, , " Error")

    End Sub
    Sub MP3Stop()
        TheFile = Chr(34) & Trim(MP3File) & Chr(34)
        mciSendString("close " & TheFile, CStr(0), 0, 0)
        Exit Sub
TheError: MsgBox(Err.Description, , " Error")

    End Sub
    Sub MP3Resume()
        TheFile = Chr(34) & Trim(MP3File) & Chr(34)
        mciSendString("play " & TheFile, "", 0, 0)
        Exit Sub
TheError: MsgBox(Err.Description, , " Error")
    End Sub
    Sub MP3Pause()
        TheFile = Chr(34) & Trim(MP3File) & Chr(34)
        Call mciSendString("Stop " & TheFile, CStr(0), 0, 0)
        Exit Sub
TheError: MsgBox(Err.Description, , " Error")
    End Sub

    Public ReadOnly Property durationInMS() As Integer

        'get duration of the song in milli-seconds

        Get

            Dim totalTime As String = Space(128)

            mciSendString("status " & TheFile & " length", totalTime, 128, 0)

            _dMS = Val(totalTime)

            durationInMS = _dMS

            totalTime = Nothing
            _dMS = Nothing

        End Get

    End Property

    Public ReadOnly Property durationInSec() As Integer

        'get the duration of the song in seconds

        Get

            _dSec = durationInMS / 1000

            durationInSec = _dSec

            _dSec = Nothing

        End Get

    End Property

    Public ReadOnly Property formatDuration() As String

        'get the duration of a song in a user friendly format, ex: 5:54

        Get

            Dim stat As String = Space(128) '128 space string buufer
            Dim totalTime As Integer = Nothing

            mciSendString("set " & TheFile & " time format ms", stat, 128, 0)
            mciSendString("status " & TheFile & " length", stat, 128, 0)

            totalTime = Val(stat)
            _fDur = getThisTime(totalTime)

            formatDuration = _fDur

            stat = Nothing
            totalTime = Nothing
            _fDur = Nothing

        End Get

    End Property

    Public Property positionInMS() As Integer

        'get the current playing position in milli-seconds

        Get

            Dim stat As String = Space(128) 'buffer with 128 spaces available

            mciSendString("set " & TheFile & " time format milliseconds", 0, 0, 0)
            mciSendString("status " & TheFile & " position", stat, 128, 0)

            _posMS = Val(stat)

            positionInMS = _posMS

            stat = Nothing
            _posMS = Nothing

        End Get

        Set(ByVal Value As Integer)

            Try

                retVal = mciSendString("set " & TheFile & " time format ms", 0, 0, 0)

                If MP3Playing() = False Then

                    mciSendString("play " & TheFile & " from " & Value, 0, 0, 0)

                Else

                    mciSendString("seek " & TheFile & " to " & Value, 0, 0, 0)

                End If

            Catch exc As Exception

                MessageBox.Show(exc.Message, " Error", MessageBoxButtons.OK)

            End Try

        End Set


    End Property

    Public ReadOnly Property positionInSec() As Integer

        'get the current playing position in seconds

        Get
            Dim pos As Integer
            _posSec = Val(positionInMS / 1000)

            positionInSec = _posSec

            _posSec = Nothing

        End Get

    End Property

    Public ReadOnly Property formatPosition() As String

        'get the current playing position in a user-friendly format, ex - 1:12

        Get

            Dim sec As Integer = Nothing
            Dim mins As Integer = Nothing

            sec = Val(positionInSec())

            If sec < 60 Then _fPos = "0:" & Format(sec, "00")

            If sec > 59 Then

                mins = Int(sec / 60)
                sec = sec - (mins * 60)

                _fPos = Format(mins, "0") & ":" & Format(sec, "00")

            End If

            formatPosition = _fPos

            sec = Nothing
            mins = Nothing
            _fPos = Nothing

        End Get

    End Property

[moti barski]

2nd part of code :

 Private Function getThisTime(ByVal timein As Integer) As String

        'used to format the position and duration propertys to a user friendly
        'format. ex: :49, 9:02, ect...

        Dim conH As Integer
        Dim conM As Integer
        Dim conS As Integer
        Dim remTime As Integer
        Dim strRetTime As String

        Try

            remTime = timein / 1000
            conH = Int(remTime / 3600)
            remTime = remTime Mod 3600
            conM = Int(remTime / 60)
            remTime = remTime Mod 60
            conS = remTime

            If conH > 0 Then

                strRetTime = Trim(Str(conH)) & ":"

            Else

                strRetTime = ""

            End If

            If conM >= 10 Then

                strRetTime = strRetTime & Trim(Str(conM))

            ElseIf conM > 0 Then

                strRetTime = strRetTime & Trim(Str(conM))

            Else

                strRetTime = strRetTime & "0"

            End If

            strRetTime = strRetTime & ":"

            If conS >= 10 Then

                strRetTime = strRetTime & Trim(Str(conS))

            ElseIf conS > 0 Then

                strRetTime = strRetTime & "0" & Trim(Str(conS))

            Else

                strRetTime = strRetTime & "00"

            End If

            getThisTime = strRetTime

            'clean up all variables
            conH = Nothing
            conM = Nothing
            conS = Nothing
            remTime = Nothing
            strRetTime = Nothing

        Catch exc As Exception

            MessageBox.Show(exc.Message, " Error", MessageBoxButtons.OK, MessageBoxIcon.Error)

        End Try

    End Function

    Public ReadOnly Property timeRemainingInMS() As Integer

        'get the time remaining in milli-seconds

        Get

            _tRemainingMS = durationInMS - positionInMS

            timeRemainingInMS = _tRemainingMS

            _tRemainingMS = Nothing

        End Get

    End Property

    Public ReadOnly Property timeRemainingInSec() As Integer

        'get the time remaining in seconds

        Get

            _tRemainingSec = durationInSec - positionInSec

            timeRemainingInSec = _tRemainingSec

            _tRemainingSec = Nothing

        End Get

    End Property

    Public ReadOnly Property formatTimeRemaining() As String

        'get the time remaining in a user friendly format - ex. 3:50

        Get

            _fTRemaining = getThisTime(timeRemainingInMS)

            formatTimeRemaining = _fTRemaining

            _fTRemaining = Nothing

        End Get

    End Property

    Public Property volumeLevel() As Integer

        'set - the sound volume level
        'get - the current sound volume level value
        '
        'note: 1000 = max volume | 0 = minimum volume value

        Get

            Dim theLevel As String = Space(128) '128 space buffer

            mciSendString("status " & TheFile & " volume", theLevel, 128, 0)

            _volLevel = Val(theLevel)

            volumeLevel = _volLevel

            theLevel = Nothing
            _volLevel = Nothing

        End Get

        Set(ByVal Value As Integer)

            mciSendString("setaudio " & TheFile & " volume to " & Value, 0, 0, 0)

        End Set

    End Property

    Public Property muteSoundOutput() As Boolean

        'set - turn the sound on or off
        'get - check if the sound is on or off

        Get

            muteSoundOutput = _muteOutput

        End Get

        Set(ByVal Value As Boolean)

            If Value = True Then

                mciSendString("setaudio " & TheFile & " off", 0, 0, 0)

                _muteOutput = Value

            Else

                mciSendString("setaudio " & TheFile & " on", 0, 0, 0)

                _muteOutput = Value

            End If

        End Set

    End Property



End Class