Private Const HI

Private Const HI Private Const HIGHEST_VOLUME_SETTING = 100 `% Private Const AUX_MAPPER = -1& Private Const MAXPNAMELEN = 32 Private Const AUXCAPS_CDAUDIO = 1 ` audio from internal CD-ROM drive Private Const AUXCAPS_AUXIN = 2 ` audio from auxiliary input jacks Private Const AUXCAPS_VOLUME = &H1 ` supports volume control Private Const AUXCAPS_LRVOLUME = &H2 ` separate left-right 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