Link to home
Start Free TrialLog in
Avatar of colinccm
colinccm

asked on

Volume control

What name is for volume control property in property registry?
Avatar of GivenRandy
GivenRandy

Registry?

To set the volume and microphone levels:

http://support.microsoft.com/support/kb/articles/Q178/4/56.ASP?LN=EN-US&SD=msdn&FR=0

To set the balance, set left and right:

http://support.microsoft.com/support/kb/articles/Q118/3/77.asp

To set the master volume level, add a VerticalScroll to the form and use this code:

---
Dim Command As String
Dim hMixer As Long
Dim VolCtrl As MIXERCONTROL
Dim hMem As Long
Dim Mxlc As MIXERLINECONTROLS
Dim Mxl As MIXERLINE
Dim Mxcd As MIXERCONTROLDETAILS
Dim Vol As MIXERCONTROLDETAILS_UNSIGNED

Const MMSYSERR_NOERROR = 0
Const MAXPNAMELEN = 32
Const MIXER_LONG_NAME_CHARS = 64
Const MIXER_SHORT_NAME_CHARS = 16
Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
Const MIXER_SETCONTROLDETAILSF_VALUE = &H0&
Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 4)
Const MIXERCONTROL_CT_CLASS_FADER = &H50000000
Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000
Const MIXERCONTROL_CONTROLTYPE_FADER = (MIXERCONTROL_CT_CLASS_FADER Or MIXERCONTROL_CT_UNITS_UNSIGNED)
Const MIXERCONTROL_CONTROLTYPE_VOLUME = (MIXERCONTROL_CONTROLTYPE_FADER + 1)

Private Type MIXERCONTROLDETAILS
    cbStruct    As Long
    dwControlID As Long
    cChannels   As Long
    item        As Long
    cbDetails   As Long
    paDetails   As Long
End Type
Private Type MIXERCONTROLDETAILS_UNSIGNED
    dwValue As Long
End Type
Private Type MIXERCONTROL
    cbStruct       As Long
    dwControlID    As Long
    dwControlType  As Long
    fdwControl     As Long
    cMultipleItems As Long
    szShortName    As String * MIXER_SHORT_NAME_CHARS
    szName         As String * MIXER_LONG_NAME_CHARS
    lMinimum       As Long
    lMaximum       As Long
    reserved(10)   As Long
End Type
Private Type MIXERLINECONTROLS
    cbStruct  As Long
    dwLineID  As Long
    dwControl As Long
    cControls As Long
    cbmxctrl  As Long
    pamxctrl  As Long
End Type
Private Type MIXERLINE
    cbStruct        As Long
    dwDestination   As Long
    dwSource        As Long
    dwLineID        As Long
    fdwLine         As Long
    dwUser          As Long
    dwComponentType As Long
    cChannels       As Long
    cConnections    As Long
    cControls       As Long
    szShortName     As String * MIXER_SHORT_NAME_CHARS
    szName          As String * MIXER_LONG_NAME_CHARS
    dwType          As Long
    dwDeviceID      As Long
    wMid            As Integer
    wPid            As Integer
    vDriverVersion  As Long
    szPname         As String * MAXPNAMELEN
End Type

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 GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" (ByVal ptr As Long, struct As Any, ByVal cb As Long)
Private Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long)
Private Declare Function mixerOpen Lib "winmm.dll" (phmx As Long, ByVal uMxId As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal fdwOpen As Long) As Long
Private Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
Private Declare Function mixerGetLineInfo Lib "winmm.dll" Alias "mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, ByVal fdwInfo As Long) As Long
Private Declare Function mixerGetLineControls Lib "winmm.dll" Alias "mixerGetLineControlsA" (ByVal hmxobj As Long, pmxlc As MIXERLINECONTROLS, ByVal fdwControls As Long) As Long

Private Sub Form_Load()
    If (mixerOpen(hMixer, 0, 0, 0, 0) <> MMSYSERR_NOERROR) Then
        MsgBox "Could not open the mixer.", vbCritical, "Volume Control"
        Exit Sub
    End If
    If (fGetVolumeControl(hMixer, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, MIXERCONTROL_CONTROLTYPE_VOLUME, VolCtrl)) Then
        VScroll1.Max = VolCtrl.lMinimum
        VScroll1.Min = VolCtrl.lMaximum \ 2
        VScroll1.SmallChange = 1000
        VScroll1.LargeChange = 1000
    End If
    mciSendString "open cdaudio", 0, 0, hWnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    mciSendString "close all", 0, 0, hWnd
End Sub

Private Sub VScroll1_Change()
    fSetVolumeControl hMixer, VolCtrl, CLng(VScroll1.Value) * 2
End Sub

Private Sub VScroll1_Scroll()
    fSetVolumeControl hMixer, VolCtrl, CLng(VScroll1.Value) * 2
End Sub

Private Sub fSetVolumeControl(ByVal hMixer As Long, Mxc As MIXERCONTROL, ByVal Volume As Long)
    Mxcd.item = 0
    Mxcd.dwControlID = Mxc.dwControlID
    Mxcd.cbStruct = Len(Mxcd)
    Mxcd.cbDetails = Len(Vol)
    hMem = GlobalAlloc(&H40, Len(Vol))
    Mxcd.paDetails = GlobalLock(hMem)
    Mxcd.cChannels = 1
    Vol.dwValue = Volume
    CopyPtrFromStruct Mxcd.paDetails, Vol, Len(Vol)
    mixerSetControlDetails hMixer, Mxcd, MIXER_SETCONTROLDETAILSF_VALUE
    Call GlobalFree(hMem)
End Sub

Private Function fGetVolumeControl(ByVal hMixer As Long, ByVal componentType As Long, ByVal ctrlType As Long, ByRef Mxc As MIXERCONTROL) As Boolean
    Mxl.cbStruct = Len(Mxl)
    Mxl.dwComponentType = componentType
    If (mixerGetLineInfo(hMixer, Mxl, MIXER_GETLINEINFOF_COMPONENTTYPE) = MMSYSERR_NOERROR) Then
        Mxlc.cbStruct = Len(Mxlc)
        Mxlc.dwLineID = Mxl.dwLineID
        Mxlc.dwControl = ctrlType
        Mxlc.cControls = 1
        Mxlc.cbmxctrl = Len(Mxc)
        hMem = GlobalAlloc(&H40, Len(Mxc))
        Mxlc.pamxctrl = GlobalLock(hMem)
        Mxc.cbStruct = Len(Mxc)
        If (mixerGetLineControls(hMixer, Mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE) = MMSYSERR_NOERROR) Then
            fGetVolumeControl = True
            Call CopyStructFromPtr(Mxc, Mxlc.pamxctrl, Len(Mxc))
        Else
            fGetVolumeControl = False
        End If
        Call GlobalFree(hMem)
        Exit Function
    End If
    fGetVolumeControl = False
End Function
---
ASKER CERTIFIED SOLUTION
Avatar of GivenRandy
GivenRandy

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of colinccm

ASKER

I test your comment, still work.
Very good ! ! Thanks ! ^ ^