Solved

Setting CD Audio Volume Level

Posted on 2000-03-16
1
217 Views
Last Modified: 2008-03-06
Hi,
a know this is a simple question , but a dont know apropriate API call.I want to know how to Get CD Audio Volume Level and how to Set CD Audio Volume Level.
In other words how to achieve the same effect as with the Wave device with functions waveOutGetVolume and waveOutSetVolume.
Thank you!
0
Comment
Question by:marsterjev
1 Comment
 

Accepted Solution

by:
sinha_sandeep earned 10 total points
ID: 3659972
'Attribute VB_Name = "MIXER"
'****************************************************************
'     ************
'* This constant holds the value of the Highest Custom volume set
'     ting. The *
'     '* lowest value will always be zero.*
'****************************************************************
'     ************
Public Const HIGHEST_VOLUME_SETTING = 12
'     'Put these into a module
'     ' device ID for aux device mapper
Public Const AUX_MAPPER = -1&
Public Const MAXPNAMELEN = 32

Type AUXCAPS
       wMid As Integer
       wPid As Integer
       vDriverVersion As Long
       szPname As String * MAXPNAMELEN
       wTechnology As Integer
       dwSupport As Long
End Type

'     ' flags for wTechnology field in AUXCAPS structure
Public Const AUXCAPS_CDAUDIO = 1 ' audio from internal CD-ROM drive
Public Const AUXCAPS_AUXIN = 2 ' audio from auxiliary input jacks
'     ' flags for dwSupport field in AUXCAPS structure
Public Const AUXCAPS_VOLUME = &H1 ' supports volume control
Public Const AUXCAPS_LRVOLUME = &H2 ' separate left-right volume control
Private Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Private Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Declare Function auxGetNumDevs Lib "winmm.dll" () As Long

Declare Function auxGetDevCaps Lib "winmm.dll" Alias "auxGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As AUXCAPS, ByVal uSize As Long) As Long

Declare Function auxSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long

Declare Function auxGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByRef lpdwVolume As Long) As Long

Declare Function auxOutMessage Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal msg As Long, ByVal dw1 As Long, ByVal dw2 As Long) As Long
       '****************************************************************
       '     ************
       '     '* Possible Return values from auxGetVolume, auxSetVolume*
       '****************************************************************
       '     ************
       Public Const MMSYSERR_NOERROR = 0
       Public Const MMSYSERR_BASE = 0
       Public Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2)
       '****************************************************************
       '     ************
       '     '* Use the CopyMemory function from the Windows API *
       '****************************************************************
       '     ************

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
       '****************************************************************
       '     ************
       '     '* Use this structure to break the Long into two Integers*
       '****************************************************************
       '     ************

Public Type VolumeSetting
       LeftVol As Integer
       RightVol As Integer
End Type


Sub lCrossFader()

       '     'Vol1 = 100 - Slider1.Value ' Left
       '     'Vol2 = 100 - Slider5.Value ' Right
       '     'E = CrossFader.Value
       '     'F = 100 - E
       '     'If Check4.Value = 1 Then ' Half Fader Check
       '     'LVol = (F * Val(Vol1) / 100) * 2
       '     'RVol = (E * Val(Vol2) / 100) * 2
       '     'If LVol > (50 * Val(Vol1) / 100) * 2 Then
       '     'LVol = (50 * Val(Vol1) / 100) * 2
       '     'End If
       '     'If RVol > (50 * Val(Vol2) / 100) * 2 Then
       '     'RVol = (50 * Val(Vol2) / 100) * 2
       '     'End If
       '     'Else
       '     'LVol = (F * Val(Vol1) / 100)
       '     'RVol = (E * Val(Vol2) / 100)
       '     'End If
       'Label1.Caption = "Fader: " + LTrim$(Str$(LVol)) + " x " + LTrim$
       '     (Str$(RVol))
       '     '
End Sub


Public Function lSetVolume(ByRef lLeftVol As Long, ByRef lRightVol As Long, lDeviceID As Long) As Long

       '****************************************************************
       '     ************
       '* This function sets the current Windows volume settings to the
       '     specified *
       '* device using two Custom numbers from 0 to HIGHEST_VOLUME_SETTI
       '     NG for the *
       '     '* right and left volume settings. *
       '     '* *
       '* The return value of this function is the Return value of the a
       '     uxGetVolume*
       '     '* Windows API call.*
       '****************************************************************
       '     ************
       Dim bReturnValue As Boolean ' Return Value from Function
       Dim Volume As VolumeSetting ' Type structure used to convert a long to/from
       '     ' two Integers.
       Dim lAPIReturnVal As Long ' Return value from API Call
       Dim lBothVolumes As Long ' The API passed value of the Combined Volumes
       '****************************************************************
       '     ************
       '     '* Calculate the Integers*
       '****************************************************************
       '     ************
       Volume.LeftVol = nSigned(lLeftVol * 65535 / HIGHEST_VOLUME_SETTING)
       Volume.RightVol = nSigned(lRightVol * 65535 / HIGHEST_VOLUME_SETTING)
       '****************************************************************
       '     ************
       '     '* Combine the Integers into a Long to be Passed to the API *
       '****************************************************************
       '     ************
       lDataLen = Len(Volume)
       CopyMemory lBothVolumes, Volume.LeftVol, lDataLen
       '****************************************************************
       '     ************
       '     '* Set the Value to the API*
       '****************************************************************
       '     ************
       lAPIReturnVal = waveOutSetVolume(lDeviceID, lBothVolumes)
       lSetVolume = lAPIReturnVal
End Function


Public Function lGetVolume(ByRef lLeftVol As Long, ByRef lRightVol As Long, lDeviceID As Long) As Long

       '****************************************************************
       '     ************
       '* This function reads the current Windows volume settings from t
       '     he *
       '     '* specified device, and returns two numbers from 0 to *
       '* HIGHEST_VOLUME_SETTING for the right and left volume settings.
       '     *
       '     '* *
       '* The return value of this function is the Return value of the a
       '     uxGetVolume*
       '     '* Windows API call.*
       '****************************************************************
       '     ************
       Dim bReturnValue As Boolean ' Return Value from Function
       Dim Volume As VolumeSetting ' Type structure used to convert a long to/from
       '     ' two Integers.
       Dim lAPIReturnVal As Long ' Return value from API Call
       Dim lBothVolumes As Long ' The API Return of the Combined Volumes
       '****************************************************************
       '     ************
       '     '* Get the Value from the API*
       '****************************************************************
       '     ************
       lAPIReturnVal = waveOutGetVolume(lDeviceID, lBothVolumes)
       '****************************************************************
       '     ************
       '     '* Split the Long value returned from the API into to Integers *
       '****************************************************************
       '     ************
       lDataLen = Len(Volume)
       CopyMemory Volume.LeftVol, lBothVolumes, lDataLen
       '****************************************************************
       '     ************
       '     '* Calculate the Return Values. *
       '****************************************************************
       '     ************
       lLeftVol = HIGHEST_VOLUME_SETTING * lUnsigned(Volume.LeftVol) / 65535
       lRightVol = HIGHEST_VOLUME_SETTING * lUnsigned(Volume.RightVol) / 65535
       lGetVolume = lAPIReturnVal
End Function


Public Function nSigned(ByVal lUnsignedInt As Long) As Integer

       Dim nReturnVal As Integer ' Return value from Function

              If lUnsignedInt > 65535 Or lUnsignedInt < 0 Then
                     MsgBox "Error in conversion from Unsigned to nSigned Integer"
                     nSignedInt = 0
                     Exit Function
              End If


              If lUnsignedInt > 32767 Then
                     nReturnVal = lUnsignedInt - 65536
              Else
                     nReturnVal = lUnsignedInt
              End If

       nSigned = nReturnVal
End Function


Public Function lUnsigned(ByVal nSignedInt As Integer) As Long

       Dim lReturnVal As Long ' Return value from Function

              If nSignedInt < 0 Then
                     lReturnVal = nSignedInt + 65536
              Else
                     lReturnVal = nSignedInt
              End If


              If lReturnVal > 65535 Or lReturnVal < 0 Then
                     MsgBox "Error in conversion from nSigned to Unsigned Integer"
                     lReturnVal = 0
              End If

       lUnsigned = lReturnVal
End Function

0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
vb6 connector to mongodb 2 122
Set email body to html using vbscript 6 49
Send outlook email from VBS Script 2 45
backup program with robocopy 6 47
When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

820 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question