Soyez le premier à donner votre avis sur cette source.
Snippet vu 8 881 fois - Téléchargée 59 fois
' Originalité de ce code pas besoins de module pour vous servir de winmm.dll ' Dans cette exemple vous pouvez mixer comme dans l'utilitaire de Windows (et c'est rapide) ' 'Il vous faut crée 3 TextBox qui afficheront l'état du canale, et un VBscrool et un objet Timer 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 AfficheEtat() 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 '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 Text1.Text = "Device #" + Str$(Cnt + 1) + ": " + Left(AC.szPname, InStr(AC.szPname, vbNullChar) - 1) 'print the left- and right volume on the form Text2.Text = "Left volume:" + Str$(HIGHEST_VOLUME_SETTING * lUnsigned(Volume.LeftVol) / 65535) Text3.Text = "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 End Sub Private Sub VScroll1_Change() lSetVolume CInt(100 - VScroll1.Value), CInt(100 - VScroll1.Value), 0 ' Noter que vous pouvez modifier une autre Device{anglais en remplçant 0 par ' 0 :: Cd ' 1 :: Line-In ' 2 :: Microphone ' 3 :: Volume principale ' 4 :: Fm synthétise End Sub Private Sub Timer1_Timer() AfficheEtat End Sub Private Sub Form_Load() 'Taux de rafraichissement ... Timer1.Interval = 1000 End Sub
10 sept. 2003 à 14:41
http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=42946&lngWId=1
6 juin 2003 à 13:16
(moi aussi ça fait depuis longtemps que je veux une table de mixage)
16 juin 2001 à 11:54
Il y a peut etre des incompatibilité avec les cartes son.
En somme il ne marche pas et j aimerait avoir de l'aide car ca fait longtemp ke j'essai de faire une table de mixage.
Merci pour toute aide apporter .
7 juin 2001 à 15:03
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.