Augmenter, baisser, le volume wave, et balance !
Description
Récupère le volume de sortie gauche et sortie droite d'une des cartes sons présente dans la machine.
Détermine la position de la balance g/d
Permet de renvoyer une nouvelle valeur pour la sortie gauche et/ou droite, ou de renvoyer une nouvelle position de balance g/d, ou encore le gain général.
Au final, l'utilisation en est aussi aisé que dans windows (volume général + balance via la fonction GetVolMoy et SetVolMoy)
Le code ci-joint contient le "kernel" a mettre dans un module .bas
Mise à jour :
- Code simplifié
- Plus de bugs corrigés "à la sauvage".
- Code plus rapide car on n'utilise plus de string$ (fonction Hex()...) pour récupérer les octets de poids fort et poids faible, mais un masque de bits.
- Démo zip enrichie (mode win et DJ)
- Renvoi du gain en décibels (dB)
Et j'ai refait l'identation : l'ancienne version était un peu "brut" ;)
Détermine la position de la balance g/d
Permet de renvoyer une nouvelle valeur pour la sortie gauche et/ou droite, ou de renvoyer une nouvelle position de balance g/d, ou encore le gain général.
Au final, l'utilisation en est aussi aisé que dans windows (volume général + balance via la fonction GetVolMoy et SetVolMoy)
Le code ci-joint contient le "kernel" a mettre dans un module .bas
Source / Exemple :
'=================================
' REGLAGE DU VOLUME WAVE
'************************
'
'par Proger - 2002
'samedi 18 mai 2002
'mise à jour du jeudi 7 août 2003 : remplacement de l'usage de Hex() par du bit-masking, plus rapide
'mise à jour du 21 février 2004 : fonctions RetGain pour avoir le volume en dB
'
'Source : déclaration des API par allapi.net
Option Explicit
DefLng A-Z
'les 2 apis nécessaire au volume
Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
'les 2 apis et le Type pour récupérer les périph' audio
Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
Declare Function waveOutGetDevCaps Lib "winmm.dll" Alias "waveOutGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As WAVEOUTCAPS, ByVal uSize As Long) As Long
Type WAVEOUTCAPS
wMid As Integer
wPid As Integer
vDriverVersion As Long
szPname As String * 260
dwFormats As Long
wChannels As Integer
dwSupport As Long
End Type
Function GetDev(NameList() As String) As Long
'recupère le nom des périph' de lecture audio
'GetDev renvoie la longueur de la liste
'La liste NameList() contiendra le nom du(des) périph'
Dim BufLng As Long
Dim exeAPI As Long
Dim CntDev As Long
Dim Temp As WAVEOUTCAPS
Dim i 'as long ==> deflng a-z
CntDev = waveOutGetNumDevs
If CntDev = 0 Then
GetDev = 0
Exit Function
Else
ReDim NameList(1 To CntDev) As String
BufLng = 274
For i = 1 To CntDev
Temp.szPname = ""
exeAPI = waveOutGetDevCaps(i - 1, Temp, BufLng)
'recupère le nom du périph
NameList(i) = Left$(Temp.szPname, InStr(1, Temp.szPname, Chr$(0), vbBinaryCompare))
Next i
GetDev = CntDev
End If
End Function
Function GetVolume(VolG As Integer, VolD As Integer, ByVal CSon As Long) As Long
'récupère la valeur gauche et droite du volume (dans VolG et VolD) de la carte son CSon
'si vous n'avez qu'une carte son, donnez comme valeur CSon = 0
Dim ValVol As Long
Dim exeAPI As Long
Dim TempG, TempD
exeAPI = waveOutGetVolume(CSon, ValVol)
'ValVol contient la valeur du volume de la façon suivante:
'ValVol fait 4 octets de long, les deux premiers contiennent
'la valeur du volume de droite, et les deux derniers gauche
'Récupération par bit-masking
TempG = (ValVol And 65535)
'on remet le champ droite sur l'intervalle 0-65535
TempD = ((ValVol And -65536) / 65536) And 65535
'et on converti en type Integer, façon la plus exploitable qui soit
VolG = CInt(TempG - 32768)
VolD = CInt(TempD - 32768)
'on envoie aussi la valeur brut du volume, on sais jamais :)
GetVolume = ValVol
End Function
Function SetVolume(ByVal VolG As Integer, ByVal VolD As Integer, ByVal CSon As Long)
'envoie la valeur gauche et droite du volume (contenu dans VolG et VolD) de la carte son CSon
'si vous n'avez qu'une carte son, donnez comme valeur CSon = 0
Dim SetVol As Long
Dim exeAPI As Long
Dim TempG, TempD
'conversion en type long (car la valeur va de 0 à 65535)
TempG = CLng(VolG) + 32768
TempD = CLng(VolD) + 32768
'on place TempD sur les 2 premiers octets (en faisant abstraction du signe)
If TempD < 32768 Then
TempD = TempD * 65536
Else
TempD = ((TempD - 32768) * 65536) Or &H80000000 'rajoute le signe
End If
'concatenation des deux valeurs (gauche et droite) par opération booléenne
SetVol = TempG Or TempD
'envoi a la carte son
exeAPI = waveOutSetVolume(CSon, SetVol)
SetVolume = SetVol 'indication a l'utilisateur de ce qu'il a envoyé :)
End Function
Function SetVolBalance(ByVal ValGini As Integer, ByVal ValDini As Integer, ValBalance As Byte, NewG As Integer, NewD As Integer) As Long
'Indiquez la valeur du son gauche et droite (avec GetVolume...),
'ainsi que la valeur de la balance
'Balance : 0 = a fond à gauche, 128 = milieu, 255 = a fond à droite
'la fonction sortira les nouvelles valeurs de gauche et droite (NewG et NewD), et ...c tout
Dim TempG As Long
Dim TempD As Long
Dim OldBalance As Byte
'on remet les valeur allant de -32768 à 32767 vers 0 à 65535
TempG = CLng(ValGini) + 32768
TempD = CLng(ValDini) + 32768
'etape 1 : on rétablie la balance à 128 (si elle ne l'est pas)
OldBalance = GetVolBalance(ValGini, ValDini)
If OldBalance <> 128 Then
If OldBalance < 128 Then 'retablissons le volume de droite
TempD = TempG
ElseIf OldBalance > 128 Then 'retablissons le volume de gauche
TempG = TempD
Else
'ce cas n'est pas censé exister.
End If
Else
'la balance actuelle est de 128 (fiou!)
End If
TempD = TempD * (ValBalance / 128)
TempG = TempG * (Abs(ValBalance - 256)) / 128
'antibug division par zéro
If TempG < 0 Then TempG = 0
If TempD < 0 Then TempD = 0
If TempG > 65535 Then TempG = 65535
If TempD > 65535 Then TempD = 65535
NewD = CInt(TempD - 32768)
NewG = CInt(TempG - 32768)
End Function
Function GetVolBalance(ValG As Integer, ValD As Integer) As Byte
'retourne la valeur de la balance dans une variable de type Byte
'en fonction de gauche et droite (récupérer par GetVolume...)
'Balance : 0 = a fond à gauche, 128 = milieu, 255 = a fond à droite
Dim TmpG As Long
Dim TmpD As Long
'on remet les valeur allant de -32768 à 32767 vers 0 à 65535
TmpG = CLng(ValG) + 32768
TmpD = CLng(ValD) + 32768
If TmpG = 0 And TmpD > 0 Then
'si y'a pas de signale a gauche, c'est que c'est à fond a droite...
GetVolBalance = 255
ElseIf TmpD = 0 And TmpG > 0 Then
'...et inversement
GetVolBalance = 0
ElseIf (TmpD - TmpG) = 0 Then
GetVolBalance = 128
Else
'on récupère l'échelle de différence entre droite et gauche,
'puis on réduit l'échelle entre 0 et 255
GetVolBalance = CByte((TmpD - TmpG + 65536) * 256 / 131072)
End If
End Function
Function GetVolMoy(CSon As Long, ValBalnce As Byte) As Integer
'fonction tout-en-un pour récuperer le volume façon windows : volume + balance
'de la carte son CSon (si vous n'avez qu'une carte, mettre CSon = 0)
'le volume est renvoyé dans GetVolMoy, et la balance dans ValBalnce
Dim VolG As Integer
Dim VolD As Integer
Dim BigVal As Long
BigVal = GetVolume(VolG, VolD, CSon)
ValBalnce = GetVolBalance(VolG, VolD)
GetVolMoy = ((CLng(VolG) + CLng(VolD)) / 2)
End Function
Function SetVolMoy(CSon As Long, ByVal VolMoyen As Integer, ValBlnc As Byte) As Long
'fonction tout-en-un pour envoyer une nouvelle valeur de volume en fonction
'du "volume moyen" et de la balance
'la fonction renvoie la valeur Long envoyé à la carte son
Dim VolFG As Integer
Dim VolFD As Integer
Dim i As Long
i = SetVolBalance(VolMoyen, VolMoyen, ValBlnc, VolFG, VolFD)
SetVolMoy = SetVolume(VolFG, VolFD, CSon)
End Function
Function RetGain(ByVal CurVol As Long) As Double
'renvoi la valeur du volume en décibel (16 bits)
'nota : la fonction log() de VB6 retourne le log népérien, alors on converti
' en log décimal en divisant par ln(10) = 2.3 ...
If CurVol > 0 Then
RetGain = (20 * (Log(CurVol) / 2.30258509299405)) - 96.3
Else
RetGain = -96.4
End If
End Function
Function InvGain(ByVal dB As Double) As Integer
'renvoi une valeur 16bits à partir du gain
'nota : le gain est compris entre 0 et -97
If dB <= -96.3 Then
InvGain = -32768
ElseIf dB < 0 Then
InvGain = (10 ^ ((dB + 96.3) / 20)) - 32768
Else
InvGain = 32767
End If
End Function
Conclusion :
Mise à jour :
- Code simplifié
- Plus de bugs corrigés "à la sauvage".
- Code plus rapide car on n'utilise plus de string$ (fonction Hex()...) pour récupérer les octets de poids fort et poids faible, mais un masque de bits.
- Démo zip enrichie (mode win et DJ)
- Renvoi du gain en décibels (dB)
Et j'ai refait l'identation : l'ancienne version était un peu "brut" ;)
Codes Sources
A voir également
- Augmenter, baisser, le volume wave, et balance !
- Calcul volume beton ✓ - Forum VB.NET
- Balance exa ✓ - Forum VB.NET
- Calculatrice volume cylindre - Forum PHP
- Balance rs232 - Forum VB.NET
- Balance precia molen erreur 26 - Forum VB.NET
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.