Trucos 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 :

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:


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



Trucos Trucos

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com