Wednesday, April 29, 2009

Auxiliary Output Device

'Auxiliary Output Device



Private Const HIGHEST_VOLUME_SETTING = 100
'%

Private Const AUX_MAPPER = -1&

Private Const MAXPNAMELEN = 32

Private Const AUXCAPS_CDAUDIO = 1         
'audio from CD


Private Const AUXCAPS_AUXIN = 2               
'audio from auxiliary input jacks


Private Const AUXCAPS_VOLUME = &H1     
'supports volume control


Private Const AUXCAPS_LRVOLUME = &H2 'separate L/R volume
control


Private Const MMSYSERR_NOERROR = 0

Private Const MMSYSERR_BASE = 0

Private Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2)



Private Type AUXCAPS

   
wMid As Integer

   
wPid As Integer

   
vDriverVersion As Long

   
szPname As String * MAXPNAMELEN

   
wTechnology As Integer

   
dwSupport As Long

End Type



Private Type VolumeSetting

   
LeftVol As Integer

   
RightVol As Integer

End Type



Private Declare Function auxGetNumDevs Lib "winmm.dll" () As Long

Private Declare Function auxGetDevCaps Lib "winmm.dll"
Alias _

"auxGetDevCapsA" (ByVal uDeviceID As Long, lpCaps
As AUXCAPS, _

ByVal uSize As Long) As Long

Private Declare Function auxSetVolume Lib "winmm.dll" _

(ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long

Private Declare Function auxGetVolume Lib "winmm.dll" _

(ByVal uDeviceID As Long,
ByRef lpdwVolume As VolumeSetting) As Long

Private Declare Sub CopyMemory Lib "kernel32"
Alias "RtlMoveMemory" _

(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)



Private Function nSigned(ByVal lUnsignedInt As Long) As Integer



Dim nReturnVal As Integer                
' Return value from Function


If lUnsignedInt > 65535 Or
lUnsignedInt < 0 Then

MsgBox "Error in conversion from Unsigned to nSigned Integer"

nSignedInt = 0

Exit Function

End If

If lUnsignedInt > 32767 Then

nReturnVal = lUnsignedInt - 65536

Else

nReturnVal = lUnsignedInt

End If

nSigned = nReturnVal



End Function



Private Function lUnsigned(ByVal nSignedInt As Integer) As Long



Dim lReturnVal As Long                    
' Return value from Function


If nSignedInt < 0 Then

lReturnVal = nSignedInt + 65536

Else

lReturnVal = nSignedInt

End If

If lReturnVal > 65535 Or lReturnVal < 0
Then

MsgBox "Error in conversion from nSigned to Unsigned Integer"

lReturnVal = 0

End If

lUnsigned = lReturnVal



End Function



Private Function lSetVolume(ByRef lLeftVol As Long, ByRef lRightVol _

As Long, lDeviceID As Long) As Long



Dim Volume As VolumeSetting, lBothVolumes As Long

Volume.LeftVol = nSigned(lLeftVol * 65535 / HIGHEST_VOLUME_SETTING)

Volume.RightVol = nSigned(lRightVol * 65535 / HIGHEST_VOLUME_SETTING)

'copy our Volume-variable to a long

CopyMemory lBothVolumes, Volume.LeftVol, Len(Volume)

'call the SetVolume-function

lSetVolume = auxSetVolume(lDeviceID, lBothVolumes)



End Function



Private Sub Form_Load()



Dim Volume As VolumeSetting, Cnt As Long, AC
As AUXCAPS

'set the output to a persistent graphic

Me.AutoRedraw = True

'loop through all the devices



For Cnt = 0 To auxGetNumDevs - 1 'auxGetNumDevs is
zero-based




'get the volume

auxGetVolume Cnt, Volume



'get the device capabilities

auxGetDevCaps Cnt, AC, Len(AC)



'print the name on the form

Me.Print "Device #" + Str$(Cnt + 1) + ": " + _

Left(AC.szPname, InStr(AC.szPname, vbNullChar) - 1)



'print the left- and right volume on the form

Me.Print "Left volume:" + _

Str$(HIGHEST_VOLUME_SETTING * lUnsigned(Volume.LeftVol) / 65535)

Me.Print "Right volume:" + _

Str$(HIGHEST_VOLUME_SETTING * lUnsigned(Volume.RightVol) / 65535)



'set the left- and right-volume to 50%

lSetVolume 50, 50, Cnt

Me.Print "Both volumes now set to 50%"



'empty line

Me.Print

Next



End Sub

 

No comments:

Post a Comment