USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Dicas

  Visual Basic    (Imagem/Som/Multimídia)

Título da Dica:  Aumentar ou baixar o volume do som ou do microfone no seu PC
Postada em 12/3/2004 por Josefh Hennyere         
'Requesitos:
'2 command Buttons
'2 TextBox
'2 labels

'Num módulo.bas, cole este 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 MIXER_SETCONTROLDETAILSF_VALUE = &H0&

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)

Public Declare Function mixerClose Lib "winmm.dll" (ByVal hmx As Long) As Long
Public Declare Function mixerGetControlDetails Lib "winmm.dll" Alias "mixerGetControlDetailsA" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
Public Declare Function mixerGetDevCaps Lib "winmm.dll" Alias "mixerGetDevCapsA" (ByVal uMxId As Long, ByVal pmxcaps As MIXERCAPS, ByVal cbmxcaps As Long) As Long
Public Declare Function mixerGetID Lib "winmm.dll" (ByVal hmxobj As Long, pumxID As Long, ByVal fdwId As Long) As Long
Public Declare Function mixerGetLineControls Lib "winmm.dll" Alias "mixerGetLineControlsA" (ByVal hmxobj As Long, pmxlc As MIXERLINECONTROLS, ByVal fdwControls As Long) As Long
Public Declare Function mixerGetLineInfo Lib "winmm.dll" Alias "mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, ByVal fdwInfo As Long) As Long
Public Declare Function mixerGetNumDevs Lib "winmm.dll" () As Long
Public Declare Function mixerMessage Lib "winmm.dll" (ByVal hmx As Long, ByVal uMsg As Long, ByVal dwParam1 As Long, ByVal dwParam2 As Long) As Long
Public 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
Public Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long

Public Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long)
Public Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" (ByVal ptr As Long, struct As Any, ByVal cb As Long)
Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long

Type MIXERCAPS
  wMid As Integer                   'manufacturer id
  wPid As Integer                   'product id
  vDriverVersion As Long            'version of the driver
  szPname As String * MAXPNAMELEN   'product name
  fdwSupport As Long                'misc. support bits
  cDestinations As Long             'count of destinations
End Type

Type MIXERCONTROL
  cbStruct As Long           'size in Byte of MIXERCONTROL
  dwControlID As Long        'unique control id for mixer device
  dwControlType As Long      'MIXERCONTROL_CONTROLTYPE_xxx
  fdwControl As Long         'MIXERCONTROL_CONTROLF_xxx
  cMultipleItems As Long     'if MIXERCONTROL_CONTROLF_MULTIPLE set
  szShortName As String * MIXER_SHORT_NAME_CHARS  ' short name of control
  szName As String * MIXER_LONG_NAME_CHARS        ' long name of control
  lMinimum As Long           'Minimum value
  lMaximum As Long           'Maximum value
  reserved(10) As Long       'reserved structure space
End Type

Type MIXERCONTROLDETAILS
  cbStruct As Long       'size in Byte of MIXERCONTROLDETAILS
  dwControlID As Long    'control id to get/set details on
  cChannels As Long      'number of channels in paDetails array
  item As Long           'hwndOwner or cMultipleItems
  cbDetails As Long      'size of _one_ details_XX struct
  paDetails As Long      'pointer to array of details_XX structs
End Type

Type MIXERCONTROLDETAILS_UNSIGNED
  dwValue As Long        'value of the control
End Type

Type MIXERLINE
  cbStruct As Long        'size of MIXERLINE structure
  dwDestination As Long   'zero based destination index
  dwSource As Long        'zero based source index (if source)
  dwLineID As Long        'unique line id for mixer device
  fdwLine As Long         'state/information about line
  dwUser As Long          'driver specific information
  dwComponentType As Long 'component type line connects to
  cChannels As Long       'number of channels line supports
  cConnections As Long    'number of connections (possible)
  cControls As Long       'number of controls at this line
  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       'size in Byte of MIXERLINECONTROLS
  dwLineID As Long       'line id (from MIXERLINE.dwLineID)
                         'MIXER_GETLINECONTROLSF_ONEBYID or
  dwControl As Long      'MIXER_GETLINECONTROLSF_ONEBYTYPE
  cControls As Long      'count of controls pmxctrl points to
  cbmxctrl As Long       'size in Byte of _one_ MIXERCONTROL
  pamxctrl As Long       'pointer to first MIXERCONTROL array
End Type

Function GetVolumeControl(ByVal hmixer As Long, ByVal componentType As Long, ByVal ctrlType As Long, ByRef mxc As MIXERCONTROL) As Boolean
  'This function attempts to obtain a mixer control.
  'Returns True if successful.
  
  Dim mxlc As MIXERLINECONTROLS
  Dim mxl As MIXERLINE
  Dim hMem As Long
  Dim rc As Long
  
  mxl.cbStruct = Len(mxl)
  mxl.dwComponentType = componentType

  ' Obtain a line corresponding to the component type
  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)
    
    'Allocate a buffer for the control
    hMem = GlobalAlloc(&H40, Len(mxc))
    mxlc.pamxctrl = GlobalLock(hMem)
    mxc.cbStruct = Len(mxc)
    
    'Get the control
    rc = mixerGetLineControls(hmixer, mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE)
    
    If (MMSYSERR_NOERROR = rc) Then
      GetVolumeControl = True
      
      'Copy the control into the destination structure
      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
  'This function sets the value for a volume control.
  'Returns True if successful
  
  Dim mxcd As MIXERCONTROLDETAILS
  Dim Vol As MIXERCONTROLDETAILS_UNSIGNED
  
  Dim hMem As Long
  Dim rc As Long
  
  mxcd.item = 0
  mxcd.dwControlID = mxc.dwControlID
  mxcd.cbStruct = Len(mxcd)
  mxcd.cbDetails = Len(Vol)
  
  ' Allocate a buffer for the control value buffer
  hMem = GlobalAlloc(&H40, Len(Vol))
  mxcd.paDetails = GlobalLock(hMem)
  mxcd.cChannels = 1
  Vol.dwValue = volume
  
  'Copy the data into the control value buffer
  CopyPtrFromStruct mxcd.paDetails, Vol, Len(Vol)
  
  'Set the control value
  rc = mixerSetControlDetails(hmixer, mxcd, MIXER_SETCONTROLDETAILSF_VALUE)
  
  GlobalFree (hMem)
  If (MMSYSERR_NOERROR = rc) Then
    SetVolumeControl = True
  Else
    SetVolumeControl = False
  End If
End Function



'No form cole este código

Option Explicit

Dim hmixer As Long          'mixer handle
Dim volCtrl As MIXERCONTROL 'waveout volume control
Dim micCtrl As MIXERCONTROL 'microphone volume control
Dim rc As Long              'return code
Dim ok As Boolean           'boolean return code

Private Sub Form_Load()
  'Open the mixer with deviceID 0.
  rc = mixerOpen(hmixer, 0, 0, 0, 0)
  If ((MMSYSERR_NOERROR <> rc)) Then
    MsgBox "Couldn't open the mixer."
    Exit Sub
  End If
  
  'Get the waveout volume control
  ok = GetVolumeControl(hmixer, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, MIXERCONTROL_CONTROLTYPE_VOLUME, volCtrl)
  If (ok = True) Then
    'If the function successfully gets the volume control,
    'the maximum and minimum values are specified by
    'lMaximum and lMinimum
    Label1.Caption = volCtrl.lMinimum & " to " & volCtrl.lMaximum
  End If
  
  ' Get the microphone volume control
  ok = GetVolumeControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE, MIXERCONTROL_CONTROLTYPE_VOLUME, micCtrl)
  If (ok = True) Then
    Label2.Caption = micCtrl.lMinimum & " to " & micCtrl.lMaximum
  End If
End Sub

Private Sub Command1_Click()
  Dim Vol As Long
  
  Vol = CLng(Text1.Text)
  SetVolumeControl hmixer, volCtrl, Vol
End Sub

Private Sub Command2_Click()
  Dim Vol As Long
  
  Vol = CLng(Text2.Text)
  SetVolumeControl hmixer, micCtrl, Vol
End Sub


'Josefh Hennyere
 


CyberWEB Network Ltda.    © Copyright 2000-2019   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página