Modificar el volumen del sonido desde VB Extraído de la KB de Microsoft (Q178456). Para modificar los niveles del volumen y del micrófono emplearemos las siguientes funciones del API : - GlobalAlloc - reserva el número de bytes de memoria que se especifiquen. - GlobalLock - bloquea un objeto de memoria global y devuelve un puntero al primer byte del objeto. El bloque de memoria asociado no puede ser movido ni descartado. - GlobalFree - libera el objeto de memoria global e invalida su handle. - mixerClose - cierra el dispositivo mezclador especificado. - mixerGetControlDetails - devuelve detalles sobre un control individual asociado con una línea de audio. - mixerGetDevCaps - consulta al mezclador especificado para conocer sus capacidades. - mixerGetID - devuelve el identificador de dispositivo del mezclador asociado con el handle de dispositivo especificado. - mixerGetLineControls - devuelve uno o más controles asociados con una línea de audio. - mixerGetLineInfo - devuelve información sobre una línea específica de un dispositivo mezclador. - mixerGetNumDevs - devuelve el número de dispositivos mezcladores presentes en el sistema. - mixerMessage - manda un mensaje directamente al driver del mezclador. - mixerOpen - abre un mezclador específico y asegura que el dispositivo no será eliminado hasta que la aplicación cierre el handle. - mixerSetControlDetails - establece propiedades de un control asociado con una línea de audio. Ejemplo Creamos un nuevo proyecto. Se crea el formulario Form1. Añadimos dos botones, dos text box y dos etiquetas al formulario. Añadimos un módulo (Module1). En la ventana de código del módulo copiamos el siguiente código : Codigo: Option Explicit Public Const MMSYSERR_NOERROR = 0 Public Const MAXPNAMELEN = 32 Public Const MIXER_LONG_NAME_CHARS = 64 Public Const MIXER_SHORT_NAME_CHARS = 16 Public Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3& Public Const MIXER_GETCONTROLDETAILSF_VALUE = &H0& Public Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2& Public Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0& Public Const MIXERLINE_COMPONENTTYPE_SRC_FIRST = &H1000& Public Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = _ (MIXERLINE_COMPONENTTYPE_DST_FIRST + 4) Public Const MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE = _ (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 3) Public Const MIXERLINE_COMPONENTTYPE_SRC_LINE = _ (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 2) Public Const MIXERCONTROL_CT_CLASS_FADER = &H50000000 Public Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000 Public Const MIXERCONTROL_CONTROLTYPE_FADER = _ (MIXERCONTROL_CT_CLASS_FADER Or _ MIXERCONTROL_CT_UNITS_UNSIGNED) Public Const MIXERCONTROL_CONTROLTYPE_VOLUME = _ (MIXERCONTROL_CONTROLTYPE_FADER + 1) Declare Function mixerClose Lib "winmm.dll" (ByVal hmx As Long) As Long Declare Function mixerGetControlDetails Lib "winmm.dll" _ Alias "mixerGetControlDetailsA" (ByVal hmxobj As Long, _ pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long Declare Function mixerGetDevCaps Lib "winmm.dll" Alias "mixerGetDevCapsA" _ (ByVal uMxId As Long, ByVal pmxcaps As MIXERCAPS, _ ByVal cbmxcaps As Long) As Long Declare Function mixerGetID Lib "winmm.dll" _ (ByVal hmxobj As Long, pumxID As Long, ByVal fdwId As Long) As Long Declare Function mixerGetLineControls Lib "winmm.dll" _ Alias "mixerGetLineControlsA" (ByVal hmxobj As Long, _ pmxlc As MIXERLINECONTROLS, ByVal fdwControls As Long) As Long Declare Function mixerGetLineInfo Lib "winmm.dll" Alias "mixerGetLineInfoA" _ (ByVal hmxobj As Long, pmxl As MIXERLINE, _ ByVal fdwInfo As Long) As Long Declare Function mixerGetNumDevs Lib "winmm.dll" () As Long Declare Function mixerMessage Lib "winmm.dll" _ (ByVal hmx As Long, ByVal uMsg As Long, ByVal dwParam1 As Long, _ ByVal dwParam2 As Long) As Long 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 Declare Function mixerSetControlDetails Lib "winmm.dll" _ (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, _ ByVal fdwDetails As Long) As Long Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" _ (struct As Any, ByVal ptr As Long, ByVal cb As Long) Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" _ (ByVal ptr As Long, struct As Any, ByVal cb As Long) Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _ ByVal dwBytes As Long) As Long Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As Long Type MIXERCAPS wMid As Integer ' id del fabricante wPid As Integer ' id del producto vDriverVersion As Long ' version del driver szPname As String * MAXPNAMELEN ' nombre del producto fdwSupport As Long ' bits de soporte cDestinations As Long ' numero de destinos End Type Type MIXERCONTROL cbStruct As Long ' tamaño en bytes del MIXERCONTROL dwControlID As Long ' id de control único del mixer dwControlType As Long ' MIXERCONTROL_CONTROLTYPE_xxx fdwControl As Long ' MIXERCONTROL_CONTROLF_xxx cMultipleItems As Long szShortName As String * MIXER_SHORT_NAME_CHARS ' nombre corto del control szName As String * MIXER_LONG_NAME_CHARS ' nombre largo del control lMinimum As Long ' valor mínimo lMaximum As Long ' valor máximo reserved(10) As Long ' espacio reservado End Type Type MIXERCONTROLDETAILS cbStruct As Long ' tamaño en bytes de MIXERCONTROLDETAILS dwControlID As Long ' id del control cChannels As Long ' número de canales en el array paDetails item As Long ' hwndOwner o cMultipleItems cbDetails As Long ' tamaño de la estructura details_XX paDetails As Long ' puntero al array des estructuras details_XX End Type Type MIXERCONTROLDETAILS_UNSIGNED dwValue As Long ' valor del control End Type Type MIXERLINE cbStruct As Long ' tamaño de la estructura dwDestination As Long ' índice de destino (empieza en cero) dwSource As Long ' índice de origen (empieza en cero) dwLineID As Long ' id de línea único para el mixer fdwLine As Long ' estado/información de la línea dwUser As Long ' información específica del driver dwComponentType As Long ' component type line connects to cChannels As Long ' nº de canales de línea soportados cConnections As Long ' nº de conexiones posibles cControls As Long ' nº de controles en esta línea 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 Type MIXERLINECONTROLS cbStruct As Long ' tamaño en bytes de MIXERLINECONTROLS dwLineID As Long ' id de línea (de MIXERLINE.dwLineID) ' MIXER_GETLINECONTROLSF_ONEBYID o dwControl As Long ' MIXER_GETLINECONTROLSF_ONEBYTYPE cControls As Long ' nº de controles pmxctrl en el array cbmxctrl As Long ' tamaño en bytes de un MIXERCONTROL pamxctrl As Long ' puntero al primer array MIXERCONTROL End Type Function GetVolumeControl(ByVal hmixer As Long, _ ByVal componentType As Long, _ ByVal ctrlType As Long, _ ByRef mxc As MIXERCONTROL) As Boolean ' Esta función intenta obtener un control mixer. ' Devuelve True si lo consigue Dim mxlc As MIXERLINECONTROLS Dim mxl As MIXERLINE Dim hmem As Long Dim rc As Long mxl.cbStruct = Len(mxl) mxl.dwComponentType = componentType ' Obtener una línea correspondiente al tipo de componente rc = mixerGetLineInfo(hmixer, mxl, MIXER_GETLINEINFOF_COMPONENTTYPE) If (MMSYSERR_NOERROR = rc) Then mxlc.cbStruct = Len(mxlc) mxlc.dwLineID = mxl.dwLineID mxlc.dwControl = ctrlType mxlc.cControls = 1 mxlc.cbmxctrl = Len(mxc) ' reservar un buffer para el control hmem = GlobalAlloc(&H40, Len(mxc)) mxlc.pamxctrl = GlobalLock(hmem) mxc.cbStruct = Len(mxc) ' Obtener el control rc = mixerGetLineControls(hmixer, mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE) If (MMSYSERR_NOERROR = rc) Then GetVolumeControl = True ' Copiar el control en la estructura de destino CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc) Else GetVolumeControl = False End If GlobalFree (hmem) Exit Function End If GetVolumeControl = False End Function Function SetVolumeControl(ByVal hmixer As Long, mxc As MIXERCONTROL, _ ByVal volume As Long) As Boolean ' Esta función modifica el valor del volumen de un control ' Devuelve True si lo consigue Dim mxcd As MIXERCONTROLDETAILS Dim vol As MIXERCONTROLDETAILS_UNSIGNED mxcd.item = 0 mxcd.dwControlID = mxc.dwControlID mxcd.cbStruct = Len(mxcd) mxcd.cbDetails = Len(vol) ' Reservar espacio para el buffer del valor del control hmem = GlobalAlloc(&H40, Len(vol)) mxcd.paDetails = GlobalLock(hmem) mxcd.cChannels = 1 vol.dwValue = volume ' Copiar los datos en el buffer del valor del control CopyPtrFromStruct mxcd.paDetails, vol, Len(vol) ' Modificar el valor del control rc = mixerSetControlDetails(hmixer, mxcd, MIXER_SETCONTROLDETAILSF_VALUE) GlobalFree (hmem) If (MMSYSERR_NOERROR = rc) Then SetVolumeControl = True Else SetVolumeControl = False End If End Function Copiar el siguiente código en la ventana de código del formulario Form1: Codigo: Option Explicit Dim hmixer As Long ' handle del mixer Dim volCtrl As MIXERCONTROL ' control del volumen del waveout Dim micCtrl As MIXERCONTROL ' control del volumen del micrófono Dim rc As Long ' return code Dim ok As Boolean ' return code booleano Private Sub Form_Load() ' Abrir el mixer con deviceID 0. rc = mixerOpen(hmixer, 0, 0, 0, 0) If ((MMSYSERR_NOERROR <> rc)) Then MsgBox "Couldn't open the mixer." Exit Sub End If ' Obtener el control de volumen waveout ok = GetVolumeControl(hmixer, _ MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _ MIXERCONTROL_CONTROLTYPE_VOLUME, _ volCtrl) If (ok = True) Then ' Si todo fue bien los valores máximos y mínimo están especificados ' en lMaximum y lMinimum Label1.Caption = volCtrl.lMinimum & " a " & volCtrl.lMaximum End If ' Obtener el control de volumen del micrófono ok = GetVolumeControl(hmixer, _ MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE, _ MIXERCONTROL_CONTROLTYPE_VOLUME, _ micCtrl) If (ok = True) Then Label2.Caption = micCtrl.lMinimum & " a " & micCtrl.lMaximum End If End Sub Private Sub Command1_Click() vol = CLng(Text1.Text) SetVolumeControl hmixer, volCtrl, vol End Sub Private Sub Command2_Click() vol = CLng(Text2.Text) SetVolumeControl hmixer, micCtrl, vol End Sub Pablo G. Tilotta Analista de Sistemas Argentina Comunicate conmigo vb_mundo@hotmail.com Si luchas puedes perder... pero si no luchas ya perdiste !!!