| ||||
| Respuesta: microfono vb.net encontre esto pero solo graba Private 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 Private Declare Function mixerClose Lib "winmm.dll" (ByVal hmx As Long) As Long Private Declare Function mixerGetControlDetails Lib "winmm.dll" Alias "mixerGetControlDetailsA" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long Private Declare Function mixerGetDevCaps Lib "winmm.dll" Alias "mixerGetDevCapsA" (ByVal uMxId As Long, ByVal pmxcaps As MIXERCAPS, ByVal cbmxcaps As Long) As Long Private Declare Function mixerGetID Lib "winmm.dll" (ByVal hmxobj As Long, pumxID As Long, ByVal fdwId 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 Declare Function mixerGetLineInfo Lib "winmm.dll" Alias "mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, ByVal fdwInfo As Long) As Long Private Declare Function mixerGetNumDevs Lib "winmm.dll" () As Long Private Declare Function mixerMessage Lib "winmm.dll" (ByVal hmx As Long, ByVal uMsg As Long, ByVal dwParam1 As Long, ByVal dwParam2 As Long) 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 Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long) Private Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" (ByVal ptr As Long, struct As Any, ByVal cb 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 lMixerHnd As Long Private tMIC As MIXERCONTROL Private bHasMic As Boolean Private Function GetMixer() As Boolean ' Get a Handle to the Mixer ' If we've already got one, return If lMixerHnd Then GetMixer = True Exit Function End If ' Get a new handle to the Mizer lReturn = mixerOpen(lMixerHnd, 0, 0, 0, 0) If lReturn = MMSYSERR_NOERROR Then GetMixer = True Else ' Problems opening the Mixer MsgBox "Unable to open mixer." End If End Function Public Function GetMicrophoneRecordVolume() As Long ' Retreives the current volume of the Microphone control (Recording) Dim lResult As Long, lMemHnd As Long Dim tMIXERCONTROLDETAILS As MIXERCONTROLDETAILS Dim tVOLUME As MIXERCONTROLDETAILS_UNSIGNED ' If we haven't gotten the Microphone Control yet, do so. If Not bHasMic Then bHasMic = GetMicControl() If Not bHasMic Then ' Unable to get the Microphone MsgBox "Unable to open Microphone Control" Exit Function End If ' Prep a MICERCONTROLDETAILS structure for retreiving info. about a specific control tMIXERCONTROLDETAILS.item = 0 tMIXERCONTROLDETAILS.dwControlID = tMIC.dwControlID tMIXERCONTROLDETAILS.cbStruct = Len(tMIXERCONTROLDETAILS) tMIXERCONTROLDETAILS.cbDetails = Len(tVOLUME) ' Allocate a buffer for the control's value lMemHnd = GlobalAlloc(&H40, Len(tVOLUME)) tMIXERCONTROLDETAILS.paDetails = GlobalLock(lMemHnd) tMIXERCONTROLDETAILS.cChannels = 1 ' Get the controls details Call mixerGetControlDetails(lMixerHnd, tMIXERCONTROLDETAILS, MIXER_GETCONTROLDETAILSF_VALUE) ' Copy the data into the control's VOLUME struct CopyStructFromPtr tVOLUME, tMIXERCONTROLDETAILS.paDetails, Len(tVOLUME) ' Release the memory buffer Call GlobalFree(lMemHnd) ' Return the current value GetMicrophoneRecordVolume = tVOLUME.dwValue End Function Public Sub SetMicrophoneRecordVolume(ByVal lVolume As Long) ' Set the Microphone volume used for recording Dim lResult As Long, lMemHnd As Long Dim tMIXERCONTROLDETAILS As MIXERCONTROLDETAILS Dim tVOLUME As MIXERCONTROLDETAILS_UNSIGNED ' If we haven't got the Microphone yet, do so.. If Not bHasMic Then bHasMic = GetMicControl() If Not bHasMic Then MsgBox "Unable to open Microphone Control" Exit Sub End If ' Prep the MIXERCONTROLDETAILS struct to set info. about this control tMIXERCONTROLDETAILS.item = 0 tMIXERCONTROLDETAILS.dwControlID = tMIC.dwControlID tMIXERCONTROLDETAILS.cbStruct = Len(tMIXERCONTROLDETAILS) tMIXERCONTROLDETAILS.cbDetails = Len(tVOLUME) ' Allocate a buffer for the control's volume value lMemHnd = GlobalAlloc(&H40, Len(tVOLUME)) tMIXERCONTROLDETAILS.paDetails = GlobalLock(lMemHnd) tMIXERCONTROLDETAILS.cChannels = 1 tVOLUME.dwValue = lVolume ' Copy the data from the VOLUME struct into the memory buffer CopyPtrFromStruct tMIXERCONTROLDETAILS.paDetails, tVOLUME, Len(tVOLUME) ' Set the new volume Call mixerSetControlDetails(lMixerHnd, tMIXERCONTROLDETAILS, MIXER_SETCONTROLDETAILSF_VALUE) ' Release the memory buffer Call GlobalFree(lMemHnd) End Sub Private Function GetMicControl() As Boolean ' Get the Microphone Control (from the Recording Line) Dim tMIXERLINECONTROLS As MIXERLINECONTROLS Dim tMIXERLINE As MIXERLINE Dim lMemHnd As Long Dim lReturn As Long Dim lConnections As Long Dim lIndex As Long ' Get a handle to the Mixer If Not GetMixer() Then Exit Function ' First find the WAVEIN Line tMIXERLINE.cbStruct = Len(tMIXERLINE) tMIXERLINE.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_WAVEIN lReturn = mixerGetLineInfo(lMixerHnd, tMIXERLINE, MIXER_GETLINEINFOF_COMPONENTTYPE) If lReturn <> MMSYSERR_NOERROR Then Exit Function ' Next enumerate the connections for this line, checking for the Microphone lConnections = tMIXERLINE.cConnections - 1 For lIndex = 0 To lConnections tMIXERLINE.dwSource = lIndex Call mixerGetLineInfo(lMixerHnd, tMIXERLINE, MIXER_GETLINEINFOF_SOURCE) If tMIXERLINE.dwComponentType = MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE Then Exit For End If Next ' If no microphone was found, exit If lIndex > lConnections Then Exit Function ' Extract the control for the Microphone from the line tMIXERLINECONTROLS.cbStruct = Len(tMIXERLINECONTROLS) tMIXERLINECONTROLS.dwLineID = tMIXERLINE.dwLineID tMIXERLINECONTROLS.dwControl = MIXERCONTROL_CONTROLTYPE_VOLUME tMIXERLINECONTROLS.cControls = 1 tMIXERLINECONTROLS.cbmxctrl = Len(tMIC) ' Create a buffer for the Microphone lMemHnd = GlobalAlloc(&H40, Len(tMIC)) tMIXERLINECONTROLS.pamxctrl = GlobalLock(lMemHnd) tMIC.cbStruct = Len(tMIC) ' Get the Microphone lReturn = mixerGetLineControls(lMixerHnd, tMIXERLINECONTROLS, MIXER_GETLINECONTROLSF_ONEBYTYPE) If (MMSYSERR_NOERROR = lReturn) Then GetMicControl = True ' Copy the Microphone control into the tMIC structure CopyStructFromPtr tMIC, tMIXERLINECONTROLS.pamxctrl, Len(tMIC) End If ' Release the buffer Call GlobalFree(lMemHnd) End Function |