title image

Smiley Re: EQUALIZER für VB!
Private Const HIGHEST_VOLUME_SETTING = 100 '%Private Const AUX_MAPPER = -1&Private Const MAXPNAMELEN = 32Private Const AUXCAPS_CDAUDIO = 1 ' audio from internal CD-ROM drivePrivate Const AUXCAPS_AUXIN = 2 ' audio from auxiliary input jacksPrivate Const AUXCAPS_VOLUME = &H1 ' supports volume controlPrivate Const AUXCAPS_LRVOLUME = &H2 ' separate left-right volume controlPrivate Const MMSYSERR_NOERROR = 0Private Const MMSYSERR_BASE = 0Private 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 LongEnd TypePrivate Type VolumeSetting LeftVol As Integer RightVol As IntegerEnd TypePrivate Declare Function auxGetNumDevs Lib "winmm.dll" () As LongPrivate Declare Function auxGetDevCaps Lib "winmm.dll" Alias "auxGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As AUXCAPS, ByVal uSize As Long) As LongPrivate Declare Function auxSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As LongPrivate Declare Function auxGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByRef lpdwVolume As VolumeSetting) As LongPrivate 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 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 = nReturnValEnd FunctionPrivate Function lUnsigned(ByVal nSignedInt As Integer) As Long Dim lReturnVal As Long ' Return value from Function If nSignedInt lReturnVal = nSignedInt + 65536 Else lReturnVal = nSignedInt End If If lReturnVal > 65535 Or lReturnVal MsgBox "Error in conversion from nSigned to Unsigned Integer" lReturnVal = 0 End If lUnsigned = lReturnValEnd FunctionPrivate 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 FunctionPrivate Sub Form_Load() 'KPD-Team 2000 'URL: http://www.allapi.net/ 'E-Mail: KPDTeam@hotmail.com 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 NextEnd Sub
Grüße us Kölle Hennes

geschrieben von




Beitrag anfügen