Tweet
Code:
#COMPILE EXE "MicrophoneWithBoost.exe"
#DIM ALL
'FINDING AND ADJUSTING MICROPHONE BOOST CODE TRANSLATED FROM THESE LINKS
'http://dhavalbc.blogspot.com/2014/05/getting-and-setting-microphone-gain-or.html and
'https://docs.microsoft.com/en-us/windows/win32/coreaudio/device-topologies
'Works with PBWIN 10.4 and Jose' includes
#REGISTER NONE
'#INCLUDE ONCE "MB_API_A.inc" 'WHEN USED {2,640 total lines} COMPILE TIME 0.1 seconds
'OR THESE
#INCLUDE ONCE "Win32Api.inc" 'WHEN USED {278,386 total lines} COMPILE TIME 1.4 seconds
#INCLUDE ONCE "CommCtrl.inc" 'Needed if manifest and WinXP
#INCLUDE ONCE "mmdeviceapi.inc" 'used for WASAPI
#INCLUDE ONCE "devpkey.inc" 'used for WASAPI
#INCLUDE ONCE "propvarutil.inc" 'used for WASAPI
#INCLUDE ONCE "endpointvolume.inc" 'used for WASAPI
GLOBAL hWndMain AS DWORD
GLOBAL dwNoRetMLTextBoxStyle AS DWORD
GLOBAL giProgStat AS LONG
GLOBAL hPeakMeter AS DWORD
GLOBAL PEAK AS SINGLE
GLOBAL dwSProgressStyle AS DWORD
GLOBAL dwSNBProgressStyle AS DWORD
GLOBAL dwProgressStyle AS DWORD
GLOBAL dwNBProgressStyle AS DWORD
GLOBAL dwButtonStyle AS DWORD
GLOBAL SCALER AS SINGLE
GLOBAL SCALER_MB AS SINGLE
GLOBAL pDevId AS WSTRINGZ PTR
GLOBAL devName AS WSTRING
GLOBAL pName AS WSTRINGZ PTR 'LPWSTR pName
GLOBAL giMicroMute AS LONG 'Tracks Microphone Mute status
GLOBAL pflow AS LONG 'DataFlow pflow
GLOBAL pPartType AS LONG 'PartType
GLOBAL bConnected AS LONG 'BOOL bConnected
GLOBAL connType AS LONG 'ConnectorType
GLOBAL ComponentName AS WSTRINGZ * 255
GLOBAL XFill AS STRING 'used to post text to clipboard
GLOBAL giPRTDMessage AS LONG
GLOBAL giPumpingMessages AS LONG
GLOBAL giMicrophone AS LONG ' default microphone availablility yes = 1, no = 0
GLOBAL giMicrophoneHr AS LONG
GLOBAL giMasterMicrophoneLevel AS LONG
GLOBAL gsTheMicrophoneName AS STRING
GLOBAL gpIMMDeviceEnumMicrophone AS IMMDeviceEnumerator
GLOBAL gpIMMDeviceMicrophone AS IMMDevice
GLOBAL gpIAudioEndpointVolumeMicrophone AS IAudioEndpointVolume
GLOBAL gpMeterInfo AS IAudioMeterInformation
GLOBAL pDeviceTopology AS IDeviceTopology
GLOBAL pConnFrom AS IConnector
GLOBAL pConnTo AS IConnector
GLOBAL pPartPrev AS IPart
GLOBAL pPartNext AS IPart
GLOBAL ppParts AS IPartsList
GLOBAL pIaudioVolumeLevel AS IAudioVolumeLevel
GLOBAL pSelector AS IAudioInputSelector
GLOBAL CLSID_MMDeviceEnumerator AS GUID
GLOBAL IID_IPart AS GUID
GLOBAL IID_IAudioVolumeLevel AS GUID
GLOBAL IID_IConnector AS GUID
GLOBAL IID_IAudioInputSelector AS GUID
GLOBAL IID_IAudioEndpointVolume AS GUID
GLOBAL IID_IDeviceTopology AS GUID
GLOBAL IID_IAudioMeterInformation AS GUID
%IDC_STATIC_MINVOL = 1001
%IDC_STATIC_MAXVOL = 1002
%IDC_PEAK_METER = 1003
%IDC_Timer0 = 1004
%ID_VOLUME = 1005
%ID_MUTE = 1006
%ID_VUP = 1007
%ID_VDN = 1008
%ID_VUP_MB = 1009
%ID_VDN_MB = 1010
DECLARE SUB DrawPeakMeter(HWND AS DWORD, float AS SINGLE)
'****************************
' **** MAIN ENTRY POINT ****
'****************************
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, _
BYVAL hPrevInstance AS DWORD, _
BYVAL lpCmdLine AS ASCIIZ PTR, _
BYVAL iCmdShow AS LONG) AS LONG
LOCAL Msg AS tagMsg
LOCAL W AS WndClassExA
LOCAL szAppName AS ASCIIZ * 80
LOCAL szClassName AS ASCIIZ * 80
LOCAL WndStyle AS LONG
LOCAL WndStyleX AS LONG
giProgStat = 1
CLSID_MMDeviceEnumerator = GUID$("{BCDE0395-E52F-467C-8E3D-C4579291692E}")
IID_IAudioMeterInformation = GUID$("{C02216F6-8C67-4B5B-9D00-D008E73E0064}")
IID_IDeviceTopology = GUID$("{2A07407E-6497-4A18-9787-32F79BD0D98F}")
IID_IAudioEndpointVolume = GUID$("{5CDF2C82-841E-4546-9722-0CF74078229A}")
IID_IPart = GUID$("{AE2DE0E4-5BCA-4F2D-AA46-5D13F8FDB3A9}")
IID_IAudioVolumeLevel = GUID$("{7FB7B48F-531D-44A2-BCB3-5AD5A134B3DC}")
IID_IConnector = GUID$("{9C2C4058-23F5-41DE-877A-DF3AF236A09E}")
IID_IAudioInputSelector = GUID$("{4F03DC02-5E6E-4653-8F72-A030C123D598}")
'register window class
szAppName = "Microphone with boost"
szClassName = "#32770"
W.cbSize = SIZEOF(W)
W.Style = %CS_HREDRAW OR %CS_VREDRAW '%WS_OverlappedWindow Or %WS_HScroll Or %WS_VScroll '
W.lpfnWndProc = CODEPTR(WndProc)
W.cbClsExtra = 0
W.cbWndExtra = 0
W.hInstance = hInstance
W.hIcon = 0 'LoadImage(hInstance, BYVAL 3000, %IMAGE_ICON, 0, 0, %LR_LOADMAP3DCOLORS OR %LR_DEFAULTSIZE)
W.hCursor = LoadCursorA(%NULL, BYVAL %IDC_ARROW)
W.hbrBackground = GetStockObject(%DKGRAY_BRUSH) '(%LTGRAY_BRUSH) '%COLOR_3DDKSHADOW 'COLOR_BTNSHADOW'%Color_BtnFace+1 (%COLOR_ACTIVEBORDER)
W.lpszMenuName = %NULL
W.lpszClassName = VARPTR(szClassName)
W.hIconSm = W.hIcon
RegisterClassExA W
'create window of that class
WndStyle = %WS_VISIBLE OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_SYSMENU OR %DS_SETFONT OR %DS_NOFAILCREATE 'OR %WS_POPUP OR %WS_BORDER OR %DS_MODALFRAME
WndStyleX = %WS_EX_LEFT OR %WS_EX_WINDOWEDGE OR %WS_EX_APPWINDOW
hWndMain = CreateWindowExA( _
WndStyleX, _ ' extended styles
szClassName, _ ' window class name
szAppName, _ ' caption
WndStyle, _ ' window styles
300, _ ' left
300, _ ' top
270, _ ' width
190, _ ' height
%HWND_DESKTOP, _ ' parent window handle
%NULL, _ ' window menu handle
hInstance, _ ' program instance handle
BYVAL %NULL) ' creation parameters
CALL CreateDlgControls
ShowWindow hWndMain, iCmdShow 'controls how window is to be shown. 1st must use iCmdShow
UpdateWindow hWndMain 'sends the window it's first WM_Create to display the window on the screen
'message pump - calls WndProc whenever an application-specific message is received
'WndProc can process the message, or pass it on to a the default window procedure that is built into Windows.
WHILE GetMessageA(Msg, %NULL, 0, 0) > 0
IF ISFALSE IsDialogMessageA (hWndMain, Msg) THEN
TranslateMessage Msg
DispatchMessageA Msg
END IF
WEND
END FUNCTION
'//-----------------------------------------------------------
'// DlgProc -- Dialog box procedure
'//-----------------------------------------------------------
FUNCTION WndProc (BYVAL hWnd AS DWORD, _
BYVAL wMsg AS DWORD, _
BYVAL wParam AS DWORD, _
BYVAL lParam AS LONG) EXPORT AS LONG
LOCAL xhr AS LONG
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Create a timer event every 1/8 Sec = 125
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SetTimer hWndMain, %IDC_Timer0, 125, BYVAL %NULL
SELECT CASE wMsg
CASE %WM_CREATE
gpMeterInfo = NOTHING
giMicrophone = MicrophoneCheck
SetVolumeMicrophone(SCALER)
'If an application processes this message, it should return zero to continue creation of the window.
FUNCTION = 0
EXIT FUNCTION
CASE %WM_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDCANCEL
gpIMMDeviceEnumMicrophone = NOTHING
gpIMMDeviceMicrophone = NOTHING
gpMeterInfo = NOTHING
KillTimer (hWnd, %IDC_Timer0)
EndDialog(hWnd, %TRUE)
'function = 1
CASE %ID_MUTE
IF giMicrophone = 1 THEN
IF giMicroMute = 0 THEN
'mute microphone
CALL MuteMicrophone
ELSE
'unmute microphone
CALL UnMuteMicrophone
END IF
END IF
CASE %ID_VUP
SCALER = SCALER + .05
IF SCALER > 1 THEN SCALER = 1
SetVolumeMicrophone(SCALER)
'SCALER RANGE IS 0 TO 1
CASE %ID_VDN
SCALER = SCALER - .05
IF SCALER < 0 THEN SCALER = 0
SetVolumeMicrophone(SCALER)
'SCALER RANGE IS 0 TO 1
CASE %ID_VUP_MB
IF ISOBJECT(pIaudioVolumeLevel) THEN
SCALER_MB = SCALER_MB + 10
IF SCALER_MB > 30 THEN SCALER_MB = 30
pIaudioVolumeLevel.SetLevel(0, SCALER_MB, BYVAL %NULL)
'SCALER RANGE IS 0 TO 30
END IF
CASE %ID_VDN_MB
IF ISOBJECT(pIaudioVolumeLevel) THEN
SCALER_MB = SCALER_MB - 10
IF SCALER_MB < 0 THEN SCALER_MB = 0
pIaudioVolumeLevel.SetLevel(0, SCALER_MB, BYVAL %NULL)
'SCALER RANGE IS 0 TO 30
END IF
END SELECT
'If an application processes this message, it should return zero.
FUNCTION = 0
EXIT FUNCTION
CASE %WM_TIMER
SELECT CASE wParam
CASE %IDC_Timer0
'// Update the peak meter in the dialog box.
IF ISOBJECT(gpMeterInfo) THEN
gpMeterInfo.GetPeakValue(PEAK)
CONTROL SET TEXT hWndMain, %IDC_PEAK_METER, USING$("##.#", PEAK * 100)
CONTROL SEND hWndMain, %ID_VOLUME, %PBM_SETPOS, (PEAK * 100), 0
END IF
END SELECT
'An application should return zero if it processes this message.
FUNCTION = 0
EXIT FUNCTION
CASE %WM_CLOSE
giProgStat = 0
DestroyWindow hWnd
CASE %WM_DESTROY 'window is being destroyed
'after windows is removed from screen (children still exist)
pSelector = NOTHING
gpIMMDeviceEnumMicrophone = NOTHING
gpIMMDeviceMicrophone = NOTHING
gpIAudioEndpointVolumeMicrophone = NOTHING
gpMeterInfo = NOTHING
pDeviceTopology = NOTHING
pConnFrom = NOTHING
pConnTo = NOTHING
pPartPrev = NOTHING
pPartNext = NOTHING
ppParts = NOTHING
pIaudioVolumeLevel = NOTHING
PostQuitMessage 0
'If an application processes this message, it should return zero.
FUNCTION = 0
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcA(hWnd, wMsg, wParam, lParam) 'if not handled above, pass to Windows default message handler.
END FUNCTION
SUB CreateDLGControls
LOCAL MyCtrl AS DWORD
dwNoRetMLTextBoxStyle = %WS_CHILD OR %WS_VISIBLE OR %ES_NOHIDESEL OR %ES_READONLY OR %WS_BORDER
dwSProgressStyle = %WS_CHILD OR %WS_VISIBLE OR %PBS_SMOOTH OR %WS_BORDER '%PBS_SMOOTH for undotted bar
dwSNBProgressStyle = %WS_CHILD OR %WS_VISIBLE OR %PBS_SMOOTH
dwProgressStyle = %WS_CHILD OR %WS_VISIBLE OR %WS_BORDER
dwNBProgressStyle = %WS_CHILD OR %WS_VISIBLE
dwButtonStyle = %WS_CHILD OR %WS_VISIBLE
MyCtrl = addTextBox(hWndMain, %IDC_STATIC_MINVOL, "", 10, 12, 20, 24, dwNoRetMLTextBoxStyle OR %SS_LEFT)
MyCtrl = addTextBox(hWndMain, %IDC_PEAK_METER, "", 31, 12, 40 + 164, 24, dwNoRetMLTextBoxStyle OR %SS_CENTER)
MyCtrl = addTextBox(hWndMain, %IDC_STATIC_MAXVOL, "", 40 + 196, 12, 20, 24, dwNoRetMLTextBoxStyle OR %SS_RIGHT)
MyCtrl = addProgress(hWndMain, %ID_VOLUME, "", 10, 40, 40 + 205, 12, dwSProgressStyle)
CONTROL SEND hWndMain, %ID_VOLUME, %PBM_SETRANGE, 0, MAKLNG(0, 100)
CONTROL SEND hWndMain, %ID_VOLUME, %PBM_SETSTEP, -1, 0
CONTROL SEND hWndMain, %ID_VOLUME, %PBM_SETBKCOLOR, 0, RGB(50,50,50)
CONTROL SEND hWndMain, %ID_VOLUME, %PBM_SETBARCOLOR, 0, RGB(55,224,230)
MyCtrl = addButton(hWndMain, %ID_MUTE, "Mute/Unmute", 10, 60 + 13, 120, 24, dwButtonStyle)
MyCtrl = addButton(hWndMain, %ID_VUP, "Volume Up", 10, 60 + 40, 120, 24, dwButtonStyle)
MyCtrl = addButton(hWndMain, %ID_VDN, "Volume Down", 10, 60 + 67, 120, 24, dwButtonStyle)
MyCtrl = addButton(hWndMain, %ID_VUP_MB, "Boost Up", 135, 60 + 40, 120, 24, dwButtonStyle)
MyCtrl = addButton(hWndMain, %ID_VDN_MB, "Boost Down", 135, 60 + 67, 120, 24, dwButtonStyle)
END SUB
FUNCTION addTextBox(BYVAL hParent AS DWORD, BYVAL nID AS LONG, zCaption AS ASCIIZ, BYVAL x AS LONG, BYVAL y AS LONG, BYVAL w AS LONG, BYVAL h AS LONG, BYVAL dwStyle AS DWORD) AS DWORD
LOCAL hCtrl AS DWORD
LOCAL hInstance AS DWORD
hInstance = GetWindowLongA (hWndMain, %GWL_HINSTANCE)
hCtrl = CreateWindowExA(%WS_EX_CLIENTEDGE, "Edit", zCaption, dwStyle, x, y, w, h, hParent, nID, hInstance, BYVAL %NULL)
'DisableXPThemeControl hCtrl
'IF hCtrl THEN SendMessage(hCtrl, %WM_SETFONT, gP.usefont, 0)
FUNCTION = hCtrl
END FUNCTION
FUNCTION addProgress(BYVAL hParent AS DWORD, BYVAL nID AS LONG, zCaption AS ASCIIZ, BYVAL x AS LONG, BYVAL y AS LONG, BYVAL w AS LONG, BYVAL h AS LONG, BYVAL dwStyle AS DWORD) AS DWORD
LOCAL hCtrl AS DWORD
LOCAL hInstance AS DWORD
hInstance = GetWindowLongA (hWndMain, %GWL_HINSTANCE)
hCtrl = CreateWindowExA (0, "MsCtls_Progress32", zCaption, dwStyle, x, y, w, h, hParent, nID, hInstance, BYVAL %NULL)
'DisableXPThemeControl hCtrl
'IF hCtrl THEN SendMessage(hCtrl, %WM_SETFONT, gP.usefont, 0) '%WS_EX_TRANSPARENT
FUNCTION = hCtrl
END FUNCTION
'_________________________________________________________________
'
' FUNCTION addButton
'_________________________________________________________________
FUNCTION addButton( _
BYVAL hParent AS DWORD _
, BYVAL nID AS LONG _
, zCaption AS ASCIIZ _
, BYVAL x AS LONG _
, BYVAL y AS LONG _
, BYVAL w AS LONG _
, BYVAL h AS LONG _
, BYVAL dwStyle AS DWORD _
) AS DWORD
LOCAL hCtrl AS DWORD
LOCAL hInstance AS DWORD
hInstance = GetWindowLongA (hWndMain, %GWL_HINSTANCE)
hCtrl = CreateWindowExA( _
0 _
, "Button" _
, zCaption _
, dwStyle _
, x, y, w, h _
, hParent _
, nID _
, hInstance _
, BYVAL %NULL)
'DisableXPThemeControl hCtrl
'IF hCtrl THEN SendMessageA(hCtrl, %WM_SETFONT, gP.usefont, 0)
FUNCTION = hCtrl
END FUNCTION
'_________________________________________________________________
'
' FUNCTION MuteMicrophone
'_________________________________________________________________
FUNCTION MuteMicrophone AS LONG
LOCAL xhr AS LONG
IF giMicrophone = 1 THEN
IF ISOBJECT(gpIAudioEndpointVolumeMicrophone) THEN
' // Do whathever you wish, e.g. SetMasterVolumeLevel, SetMute, etc.
' // See available methods at http://msdn.microsoft.com/en-us/library/windows/desktop/dd370892%28v=vs.85%29.aspx
xhr = gpIAudioEndpointVolumeMicrophone.SetMute(%TRUE, BYVAL %NULL)
IF FAILED(xhr) THEN
'CALL SHOW_NOTES_NO_WAIT("Unable to mute default microphone.")
? "Unable to set mute state on default microphone"
ELSE
' "Default microphone muted successfully!"
giMicroMute = 1
'CALL PutPeriodOnMarque
END IF
END IF
END IF
FUNCTION = 1
END FUNCTION
'_________________________________________________________________
'
' FUNCTION UnMuteMicrophone
'_________________________________________________________________
FUNCTION UnMuteMicrophone AS LONG
LOCAL xhr AS LONG
IF giMicrophone = 1 THEN
IF ISOBJECT(gpIAudioEndpointVolumeMicrophone) THEN
' // Do whathever you wish, e.g. SetMasterVolumeLevel, SetMute, etc.
' // See available methods at http://msdn.microsoft.com/en-us/library/windows/desktop/dd370892%28v=vs.85%29.aspx
xhr = gpIAudioEndpointVolumeMicrophone.SetMute(%FALSE, BYVAL %NULL)
IF FAILED(xhr) THEN
'CALL SHOW_NOTES_NO_WAIT("Unable to unmute default microphone.")
? "Unable to set unmute state on default microphone"
ELSE
' "Default microphone unmuted successfully!"
giMicroMute = 0
'INCR giTestIt
'IF RecognitionStatus = 1 THEN
' CALL PutQuestionMarkOnMarque
'ELSE
' 'recognition is not enabled
' IF ISTRUE ISOBJECT(oRecoContext) THEN
' CALL PutTildeOnMarque
' ELSE
' CALL PutEqualSignOnMarque
' END IF
'END IF
END IF
END IF
END IF
FUNCTION = 1
END FUNCTION
'_________________________________________________________________
'
' FUNCTION SetVolumeMicrophone
'_________________________________________________________________
FUNCTION SetVolumeMicrophone(BYVAL MicroScalar AS SINGLE) AS LONG
LOCAL xhr AS LONG
IF giMicrophone = 1 THEN
IF ISOBJECT(gpIAudioEndpointVolumeMicrophone) THEN
' // Do whathever you wish, e.g. SetMasterVolumeLevel, SetMute, etc.
' // See available methods at http://msdn.microsoft.com/en-us/library/windows/desktop/dd370892%28v=vs.85%29.aspx
xhr = gpIAudioEndpointVolumeMicrophone.SetMasterVolumeLevelScalar(MicroScalar, BYVAL %NULL)
IF FAILED(xhr) THEN
'CALL SHOW_NOTES_NO_WAIT("Unable to set scalar on default microphone.")
? "Unable to set volume state on default microphone"
FUNCTION = 0
EXIT FUNCTION
ELSE
' "Default microphone volume set successfully!"
END IF
END IF
END IF
FUNCTION = 1
END FUNCTION
'_________________________________________________________________
'
' FUNCTION MicrophoneCheck new 2020 MAY 06 new
'_________________________________________________________________
FUNCTION MicrophoneCheck AS LONG
LOCAL xhr AS LONG
LOCAL fMinDb AS SINGLE 'float fMinDb
LOCAL fMaxDb AS SINGLE 'float fMaxDb
LOCAL fStepDb AS SINGLE 'float fStepDb
LOCAL pfCurrentDb AS SINGLE 'float pfCurrentDb
' Get enumerator for audio endpoint devices.
gpIMMDeviceEnumMicrophone = NEWCOM CLSID CLSID_MMDeviceEnumerator
IF ISNOTHING(gpIMMDeviceEnumMicrophone) THEN
? "Unable to create audio device enumerator."
FUNCTION = 0
EXIT FUNCTION
END IF
' // Enumerate the audio endpoints of interest (in this case audio capture endpoints)
' // The flags that can be used are:
' // %EDataFlow_eRender (for audio output endpoints),
' // %EDataFlow_eCapture (for audio capture endpoints),
' // %EDataFlow_eAll (for all audio endpoints)
' // %ERole_eConsole = Games, system notification sounds, and voice commands.
' // %ERole_eMultimedia = Music, movies, narration, and live music recording.
' // %ERole_eCommunications = Voice communications (talking to another person).
'%DEVICE_STATE_ACTIVE
giMicrophoneHr = gpIMMDeviceEnumMicrophone.GetDefaultAudioEndpoint(%EDataFlow_eCapture, %ERole_eConsole, gpIMMDeviceMicrophone)
IF FAILED(giMicrophoneHr) THEN
? "Unable to find default microphone device."
FUNCTION = 0
EXIT FUNCTION
END IF
xhr = gpIMMDeviceMicrophone.Activate(IID_IAudioEndpointVolume, %CLSCTX_INPROC_SERVER, BYVAL %NULL, gpIAudioEndpointVolumeMicrophone)
IF FAILED(xhr) THEN
'CALL SHOW_NOTES_NO_WAIT("Unable to activate a microphone.")
? "Unable to activate default microphone"
FUNCTION = 0
EXIT FUNCTION
ELSE
' "Default microphone activated successfully!"
' // Get the device identifier
xhr = gpIMMDeviceMicrophone.GetId(pDevId)
IF pDevId THEN
XFill = "Device id = " & @pDevId 'Device id = {0.0.1.00000000}.{be4cea6b-aba4-4420-8e08-dbfb7a6be10c}
'call COPY_TO_CLIPBOARD
CoTaskMemFree(pDevId)
END IF
' // Get the device name
gsTheMicrophoneName = AfxGetDeviceName(gpIMMDeviceMicrophone)
'? gsTheMicrophoneName
'Get the endpoint device's IDeviceTopology interface.
xhr = gpIMMDeviceMicrophone.Activate(IID_IDeviceTopology, %CLSCTX_ALL, BYVAL %NULL, pDeviceTopology)
IF FAILED(xhr) THEN
'CALL SHOW_NOTES_NO_WAIT("Unable to get microphone topology.")
? "Unable to get microphone topology."
FUNCTION = 0
EXIT FUNCTION
END IF
'The device topology for an endpoint device always
'contains just one connector (connector number 0).
xhr = pDeviceTopology.GetConnector(0, pConnFrom)
IF FAILED(xhr) THEN
'CALL SHOW_NOTES_NO_WAIT("Unable to get the connector info.")
? "Unable to get the connector info."
FUNCTION = 0
EXIT FUNCTION
END IF
pDeviceTopology = NOTHING
'Make sure that this is a capture device.
xhr = pConnFrom.GetDataFlow(pflow)
IF FAILED(xhr) THEN
'CALL SHOW_NOTES_NO_WAIT("Unable to get connector flow data.")
? "Unable to get connector flow data."
FUNCTION = 0
EXIT FUNCTION
ELSE
'For example, a typical rendering device on an adapter has a connector
'with data-flow direction "In" through which the Windows audio engine
'streams PCM data into the device. The same device has a connector with
'data-flow direction "Out" through which the device transmits an audio
'signal to speakers or headphones.
'%DataFlow_In = 0 Input stream. The audio stream flows into the device through the connector.
'%DataFlow_Out = 1 Output stream. The audio stream flows out of the device through the connector.
SELECT CASE pFlow
CASE 0 'In
'Error -- this is a rendering device.
'EXIT_ON_ERROR(xhr = %AUDCLNT_E_WRONG_ENDPOINT_TYPE)
'CALL SHOW_NOTES_NO_WAIT("Error! The connector flow data was wrong.")
? "Error! The connector flow data was wrong."
FUNCTION = 0
EXIT FUNCTION
CASE 1 'Out
'? "DataFlow is out stream."
END SELECT
END IF
'--------------------------------------
ComponentName = "Microphone"
pfCurrentDb = 0
CALL SelectCaptureDevice
IF ISOBJECT(pIaudioVolumeLevel) THEN
pIaudioVolumeLevel.GetLevelRange(0, fMinDb, fMaxDb, fStepDb)
'? "VMIN" & STR$(fMinDb)
'? "VMAX" & STR$(fMaxDb)
'? "VSTEP" & STR$(fStepDb)
pIaudioVolumeLevel.GetLevel(0, pfCurrentDb)
'? "VCUR" & STR$(pfCurrentDb)
pfCurrentDb = (INT(10 * ((pfCurrentDb + 34.5)/46.5) * 100)) /10 'rescale values
SELECT CASE pfCurrentDb
CASE 0 TO 17.2
'? STR$(pfCurrentDb)
SCALER = 0
CASE 17.3 TO 28.4
'? STR$(pfCurrentDb)
SCALER = .05
CASE 28.5 TO 36.8
'? STR$(pfCurrentDb)
SCALER = .1
CASE 36.9 TO 43.4
'? STR$(pfCurrentDb)
SCALER = .15
CASE 43.5 TO 48.9
'? STR$(pfCurrentDb)
SCALER = .2
CASE 49 TO 53.7
'? STR$(pfCurrentDb)
SCALER = .25
CASE 53.8 TO 57.8
'? STR$(pfCurrentDb)
SCALER = .3
CASE 57.9 TO 61.5
'? STR$(pfCurrentDb)
SCALER = .3
CASE 61.6 'to 67.7
'? STR$(pfCurrentDb)
SCALER = .4
CASE 64.8 'to 67.7
'? STR$(pfCurrentDb)
SCALER = .45
CASE 67.8 TO 70.5
'? STR$(pfCurrentDb)
SCALER = .5
CASE 70.6 TO 73
'? STR$(pfCurrentDb)
SCALER = .55
CASE 73.1 TO 75.4
'? STR$(pfCurrentDb)
SCALER = .6
CASE 75.5 TO 78
'? STR$(pfCurrentDb)
SCALER = .65
CASE 78.1 TO 80.7
'? STR$(pfCurrentDb)
SCALER = .7
CASE 80.8 TO 83.8
'? STR$(pfCurrentDb)
SCALER = .75
CASE 83.9 TO 87.1
'? STR$(pfCurrentDb)
SCALER = .8
CASE 87.2 TO 90.8
'? STR$(pfCurrentDb)
SCALER = .855
CASE 90.9 TO 95
'? STR$(pfCurrentDb)
SCALER = .9
CASE 95.1 TO 99.9
'? STR$(pfCurrentDb)
SCALER = .95
CASE 100
'? STR$(pfCurrentDb)
SCALER = 1
CASE ELSE
'? STR$(pfCurrentDb)
SCALER = pfCurrentDb
END SELECT
ELSE
? "There is no audio level object!"
END IF
'--------------------------------------
ComponentName = "Microphone Boost"
pIaudioVolumeLevel = NOTHING
pfCurrentDb = 0
CALL SelectCaptureDevice
IF ISOBJECT(pIaudioVolumeLevel) THEN
'? "made it here"
pIaudioVolumeLevel.GetLevelRange(0, fMinDb, fMaxDb, fStepDb)
'? "VMIN" & STR$(fMinDb)
'? "VMAX" & STR$(fMaxDb)
'? "VSTEP" & STR$(fStepDb)
pIaudioVolumeLevel.GetLevel(0, pfCurrentDb)
'? "VCUR" & STR$(pfCurrentDb)
pIaudioVolumeLevel.SetLevel(0, pfCurrentDb, BYVAL %NULL)
SCALER_MB = pfCurrentDb
END IF
pConnFrom = NOTHING
'\\\\\\\\\\\\\\\
'Get the endpoint device's IAudioMeterInformation interface.
xhr = gpIMMDeviceMicrophone.Activate(IID_IAudioMeterInformation, %CLSCTX_ALL, BYVAL %NULL, gpMeterInfo)
IF FAILED(xhr) THEN
'CALL SHOW_NOTES_NO_WAIT("Unable to get peak meter info.")
? "Unable to get peak meter info."
FUNCTION = 0
EXIT FUNCTION
END IF
END IF
FUNCTION = 1
END FUNCTION
'_________________________________________________________________
'
' FUNCTION AfxGetDeviceName Jarvis
'_________________________________________________________________
' ================================================================
' Helper function to retrieve the friendly name of the
' audio device.
' ================================================================
FUNCTION AfxGetDeviceName (BYVAL pDev AS IMMDevice) AS WSTRING
LOCAL hr AS LONG
LOCAL pPropStore AS IPropertyStore
hr = pDev.OpenPropertyStore(%STGM_READ, pPropStore)
IF FAILED(hr) THEN EXIT FUNCTION
LOCAL friendlyName AS PROPVARIANT
PropVariantInit(friendlyName)
hr = pPropStore.getValue(DEVPKEY_Device_FriendlyName, friendlyName)
IF FAILED(hr) THEN EXIT FUNCTION
LOCAL wszDevName AS WSTRINGZ * 128
PropVariantToString(friendlyName, wszDevName, 128)
FUNCTION = wszDevName
PropVariantClear(friendlyName)
END FUNCTION
'_________________________________________________________________
'
' SUB COPY_TO_CLIPBOARD EjectDrive
'_________________________________________________________________
SUB COPY_TO_CLIPBOARD
CopyToClipBoard 0, BYCOPY XFill
XFill = ""
END SUB
'_________________________________________________________________
'
' FUNCTION CopyToClipBoard VER4
'_________________________________________________________________
FUNCTION CopyToClipBoard(HParent AS LONG, MyText AS STRING) AS LONG
LOCAL HptrMemory AS DWORD
LOCAL HptrAsciiz AS ASCIIZ PTR
OpenClipboard HParent
IF ISFALSE(EmptyClipboard) THEN
CloseClipboard
EXIT FUNCTION
END IF
HptrMemory = GlobalAlloc(%GHND, ((LEN(MyText) + 1) + TALLY(MyText, ANY ($CRLF & $TAB))))
HptrAsciiz = GlobalLock(HptrMemory)
@HptrAsciiz = MyText
GlobalUnlock HptrMemory
FUNCTION = SetClipboardData(%CF_TEXT, HptrMemory)
CloseClipboard
END FUNCTION
'_________________________________________________________________
'_________________________________________________________________
'
' Processes pending Windows messages. VER4
' Call this procedure if you are performing a tight
' FOR/NEXT or DO/LOOP and need to allow
' your application to be responsive to user input.
' Modified version of AfxPumpMessages
'_________________________________________________________________
SUB MyPumpMessages(BYVAL xTimes AS LONG) EXPORT
'/////////////////////////////////////////////////////////////
'Do not want to remove the WM_QUIT message from message que.
' IF GlobalVariableTest86 = 1 THEN EXIT SUB
'/////////////////////////////////////////////////////////////
LOCAL Ix AS LONG
IF giPumpingMessages = 1 THEN EXIT SUB
giPumpingMessages = 1
' IF GlobalVariableTestOn THEN
IF xTimes <= 0 THEN xTimes = 1
FOR Ix = 1 TO xTimes
CALL PeekRemoveTranslateDispatchMessage
' IF GlobalVariableTest86 = 1 THEN GOTO NoMoreNeeded
NEXT Ix
' END IF
NoMoreNeeded:
giPumpingMessages = 0
END SUB
'_________________________________________________________________
'
' SUB PeekRemoveTranslateDispatchMessage VER4
'_________________________________________________________________
SUB PeekRemoveTranslateDispatchMessage
'/////////////////////////////////////////////////////////////
'Do not want to remove the WM_QUIT message from message que.
' IF GlobalVariableTest86 = 1 THEN EXIT SUB
'/////////////////////////////////////////////////////////////
'Could use this to signal main message loop to close
'PostThreadMessageA (GetCurrentThreadID, %WM_QUIT, 0, 0) ' Signal Quit to Msg Loop
IF giPRTDMessage = 1 THEN EXIT SUB
giPRTDMessage = 1
STATIC Msg AS tagMsg
IF PeekMessageA(Msg, %NULL, %NULL, %NULL, %PM_REMOVE) THEN
TranslateMessage Msg
DispatchMessageA Msg
END IF
giPRTDMessage = 0
END SUB
'//-----------------------------------------------------------
'// This function traverses the data path that extends from the
'// endpoint device to the system bus (for example, PCI)
'// or external bus (USB). If the function discovers a MUX
'// (input selector) in the path, it selects the MUX input
'// that connects to the stream from the endpoint device.
'// In this case we are looking for the Microphone or Microphone
'// Boost parts.
'//-----------------------------------------------------------
'Limits of Device Topology
'Where (con) is a connector
'microphone -> endpoint device B (con) physical external
'
'-> Input Multiplexer Device (Topology Filter)
' (con) physical external IPart & IConnector
' subunit Mute -> IPart & ISubUnit
' subunit Vol -> IPart & ISubUnit
' subunit MUX -> IPart & ISubUnit
' (Con) Software Fixed IPart & IConnector
'
'-> Wave Capture Device (Wave Filter)
' (Con) Software Fixed IPart & IConnector
' subunit ADC IPart & ISubUnit
' (Con) Software IO IPart & IConnector
'
'-> System Bus Wave-in Stream (DMA)
FUNCTION SelectCaptureDevice() AS LONG
LOCAL hr AS LONG
hr = %S_OK
pIaudioVolumeLevel = NOTHING
IF ISOBJECT(pConnFrom) THEN
'continue
ELSE
GOTO ExitHere
END IF
'// Outer loop: Each iteration traverses the data path
'// through a device topology starting at the input
'// connector and ending at the output connector.
WHILE %TRUE
IF giProgStat = 0 THEN GOTO ExitHere
hr = pConnFrom.IsConnected(bConnected)
IF FAILED(hr) THEN GOTO ExitHere
'// Does this connector connect to another device?
IF bConnected = %FALSE THEN
'// This is the end of the data path that
'// stretches from the endpoint device to the
'// system bus or external bus. Verify that
'// the connection type is Software_IO.
hr = pConnFrom.GetType(connType)
IF FAILED(hr) THEN GOTO ExitHere
IF connType = %ConnectorType_Software_IO THEN
'? "Finished looking for connections."
EXIT LOOP '// finished
END IF
IF FAILED(hr = %E_FAIL) THEN GOTO ExitHere
END IF
'// Get the connector in the next device topology,
'// which lies on the other side of the connection.
hr = pConnFrom.GetConnectedTo(pConnTo)
IF FAILED(hr) THEN GOTO ExitHere
'// Get the connector's IPart interface.
hr = pConnTo.QueryInterface( _
IID_IPart, _
BYVAL VARPTR(pPartPrev))
IF FAILED(hr) THEN GOTO ExitHere
pConnTo = NOTHING
'// Inner loop: Each iteration traverses one link in a
'// device topology and looks for input multiplexers.
WHILE %TRUE
IF giProgStat = 0 THEN GOTO ExitHere
MyPumpMessages(2000)
'// Follow downstream link to next part.
hr = pPartPrev.EnumPartsOutgoing(ppParts)
IF FAILED(hr) THEN GOTO ExitHere
hr = ppParts.GetPart(0, pPartNext)
ppParts = NOTHING
IF FAILED(hr) THEN GOTO ExitHere
hr = pPartNext.GetPartType(pPartType)
IF FAILED(hr) THEN GOTO ExitHere
IF SUCCEEDED(pPartNext.GetName(pName)) THEN
'? @pName '=Microphone or Microphone Boost
'Failure of the following call means only that
'the part is not a boost (microphone boost).
IF UCASE$(ComponentName) <> UCASE$(@pName) THEN
'? "Not a match."
ELSE
'? "The part name matched."
'get IAudioVolumeLevel to control volume
hr = pPartNext.Activate(%CLSCTX_ALL, IID_IAudioVolumeLevel, pIaudioVolumeLevel)
GOTO ExitHere
END IF
CoTaskMemFree(pName)
END IF
'? "Try again..."
SELECT CASE pPartType
CASE %PartType_Connector '=0
'? "Connector found."
'// We've reached the output connector that
'// lies at the end of this device topology.
hr = pPartNext.QueryInterface( _
IID_IConnector, _
BYVAL VARPTR(pConnFrom))
IF FAILED(hr) THEN GOTO ExitHere
pPartPrev = NOTHING
pPartNext = NOTHING
EXIT LOOP
CASE %PartType_Subunit '=1
'? "Subunit found."
END SELECT
'// Failure of the following call means only that
'// the part is not a MUX (input selector).
hr = pPartNext.Activate( _
%CLSCTX_ALL, _
IID_IAudioInputSelector, _
pSelector)
IF hr = %S_OK THEN
? "The MUX was found."
'// We found a MUX (input selector), so select
'// the input from our endpoint device.
LOCAL localId AS DWORD
hr = pPartPrev.GetLocalId(localId)
IF FAILED(hr) THEN GOTO ExitHere
hr = pSelector.SetSelection(localId, BYVAL %NULL)
IF FAILED(hr) THEN GOTO ExitHere
pSelector = NOTHING
END IF
pPartPrev = NOTHING
pPartPrev = pPartNext
pPartNext = NOTHING
WEND
WEND
ExitHere:
ppParts = NOTHING
pConnTo = NOTHING
pPartPrev = NOTHING
pPartNext = NOTHING
pSelector = NOTHING
FUNCTION = hr
END FUNCTION
Comment