colinccm
asked on
Volume control
What name is for volume control property in property registry?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
I test your comment, still work.
Very good ! ! Thanks ! ^ ^
Very good ! ! Thanks ! ^ ^
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_UNSIGN
Const MMSYSERR_NOERROR = 0
Const MAXPNAMELEN = 32
Const MIXER_LONG_NAME_CHARS = 64
Const MIXER_SHORT_NAME_CHARS = 16
Const MIXER_GETLINEINFOF_COMPONE
Const MIXER_SETCONTROLDETAILSF_V
Const MIXER_GETLINECONTROLSF_ONE
Const MIXERLINE_COMPONENTTYPE_DS
Const MIXERLINE_COMPONENTTYPE_DS
Const MIXERCONTROL_CT_CLASS_FADE
Const MIXERCONTROL_CT_UNITS_UNSI
Const MIXERCONTROL_CONTROLTYPE_F
Const MIXERCONTROL_CONTROLTYPE_V
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_UNSIGN
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,
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_V
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_COMPONE
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(hMix
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
---