Accueil > > > REGLER LE VOLUME SONORE
REGLER LE VOLUME SONORE
Information sur la source
Description
Permet simplement de régler le volume sonore de windows
Ti£oi$
Source
- Const MMSYSERR_NOERROR = 0
- Const MAXPNAMELEN = 32
- Const MIXER_LONG_NAME_CHARS = 64
- Const MIXER_SHORT_NAME_CHARS = 16
- Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
- Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
- Const MIXER_SETCONTROLDETAILSF_VALUE = &H0&
- Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
- Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = &H4
- Const MIXERCONTROL_CONTROLTYPE_VOLUME = &H50030001
-
- Private Declare Function mixerOpen Lib "winmm.dll" (phmx As Long, _
- ByVal uMxId As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, _
- ByVal fdwOpen As Long) As Long
- Private Declare Function mixerGetLineInfo Lib "winmm.dll" Alias _
- "mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, _
- ByVal fdwInfo As Long) As Long
- Private Declare Function mixerGetLineControls Lib "winmm.dll" Alias _
- "mixerGetLineControlsA" (ByVal hmxobj As Long, pmxlc As MIXERLINECONTROLS, _
- ByVal fdwControls As Long) As Long
- Private Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj _
- As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
- Private Declare Function mixerClose Lib "winmm.dll" (ByVal hmx As Long) As Long
- Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
- (Destination As Any, Source As Any, ByVal Length As Long)
- Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
- ByVal dwBytes As Long) As Long
- Private Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long
- Private Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As Long
-
- Private Type MIXERCONTROL
- cbStruct As Long
- dwControlID As Long
- dwControlType As Long
- fdwControl As Long
- cMultipleItems As Long
- szShortName As String * MIXER_SHORT_NAME_CHARS
- szName As String * MIXER_LONG_NAME_CHARS
- lMinimum As Long
- lMaximum As Long
- reserved(10) As Long
- End Type
-
- Private Type MIXERCONTROLDETAILS
- cbStruct As Long
- dwControlID As Long
- cChannels As Long
- item As Long
- cbDetails As Long
- paDetails As Long
- End Type
-
- Private Type MIXERCONTROLDETAILS_UNSIGNED
- dwValue As Long
- End Type
-
- Private Type MIXERLINE
- cbStruct As Long
- dwDestination As Long
- dwSource As Long
- dwLineID As Long
- fdwLine As Long
- dwUser As Long
- dwComponentType As Long
- cChannels As Long
- cConnections As Long
- cControls As Long
- szShortName As String * MIXER_SHORT_NAME_CHARS
- szName As String * MIXER_LONG_NAME_CHARS
- dwType As Long
- dwDeviceID As Long
- wMid As Integer
- wPid As Integer
- vDriverVersion As Long
- szPname As String * MAXPNAMELEN
- End Type
-
- Private Type MIXERLINECONTROLS
- cbStruct As Long
- dwLineID As Long
- dwControl As Long
- cControls As Long
- cbmxctrl As Long
- pamxctrl As Long
- End Type
-
- 'Le volume est exprimé en pourcentage (entre 0 et 100)
- 'la fonction returne true si ca a fonctionné
-
- Function SetVolume(VolumeLevel As Long) As Boolean
- Dim hmx As Long
- Dim uMixerLine As MIXERLINE
- Dim uMixerControl As MIXERCONTROL
- Dim uMixerLineControls As MIXERLINECONTROLS
- Dim uDetails As MIXERCONTROLDETAILS
- Dim uUnsigned As MIXERCONTROLDETAILS_UNSIGNED
- Dim RetValue As Long
- Dim hmem As Long
-
- If VolumeLevel < 0 Or VolumeLevel > 100 Then GoTo error
-
- RetValue = mixerOpen(hmx, 0, 0, 0, 0)
- If RetValue <> MMSYSERR_NOERROR Then GoTo error
-
- uMixerLine.cbStruct = Len(uMixerLine)
- uMixerLine.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS
- RetValue = mixerGetLineInfo(hmx, uMixerLine, _
- MIXER_GETLINEINFOF_COMPONENTTYPE)
- If RetValue <> MMSYSERR_NOERROR Then GoTo error
-
- uMixerLineControls.cbStruct = Len(uMixerLineControls)
- uMixerLineControls.dwLineID = uMixerLine.dwLineID
- uMixerLineControls.dwControl = MIXERCONTROL_CONTROLTYPE_VOLUME
- uMixerLineControls.cControls = 1
- uMixerLineControls.cbmxctrl = Len(uMixerControl)
-
-
- hmem = GlobalAlloc(&H40, Len(uMixerControl))
- uMixerLineControls.pamxctrl = GlobalLock(hmem)
- uMixerControl.cbStruct = Len(uMixerControl)
- RetValue = mixerGetLineControls(hmx, uMixerLineControls, _
- MIXER_GETLINECONTROLSF_ONEBYTYPE)
- If RetValue <> MMSYSERR_NOERROR Then GoTo error
- CopyMemory uMixerControl, ByVal uMixerLineControls.pamxctrl, _
- Len(uMixerControl)
- GlobalFree hmem
- hmem = 0
-
- uDetails.item = 0
- uDetails.dwControlID = uMixerControl.dwControlID
- uDetails.cbStruct = Len(uDetails)
- uDetails.cbDetails = Len(uUnsigned)
- hmem = GlobalAlloc(&H40, Len(uUnsigned))
- uDetails.paDetails = GlobalLock(hmem)
- uDetails.cChannels = 1
- uUnsigned.dwValue = CLng((VolumeLevel * uMixerControl.lMaximum) / 100)
- CopyMemory ByVal uDetails.paDetails, uUnsigned, Len(uUnsigned)
- RetValue = mixerSetControlDetails(hmx, uDetails, _
- MIXER_SETCONTROLDETAILSF_VALUE)
- GlobalFree hmem
- hmem = 0
- If RetValue <> MMSYSERR_NOERROR Then GoTo error
-
- mixerClose hmx
- SetVolume = True
- Exit Function
-
- error:
- ' Une erreur s'est produite
-
- If hmx <> 0 Then mixerClose hmx
- If hmem Then GlobalFree hmem
- SetVolume = False
-
- End Function
Const MMSYSERR_NOERROR = 0
Const MAXPNAMELEN = 32
Const MIXER_LONG_NAME_CHARS = 64
Const MIXER_SHORT_NAME_CHARS = 16
Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
Const MIXER_SETCONTROLDETAILSF_VALUE = &H0&
Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = &H4
Const MIXERCONTROL_CONTROLTYPE_VOLUME = &H50030001
Private Declare Function mixerOpen Lib "winmm.dll" (phmx As Long, _
ByVal uMxId As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, _
ByVal fdwOpen As Long) As Long
Private Declare Function mixerGetLineInfo Lib "winmm.dll" Alias _
"mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, _
ByVal fdwInfo As Long) As Long
Private Declare Function mixerGetLineControls Lib "winmm.dll" Alias _
"mixerGetLineControlsA" (ByVal hmxobj As Long, pmxlc As MIXERLINECONTROLS, _
ByVal fdwControls As Long) As Long
Private Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj _
As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
Private Declare Function mixerClose Lib "winmm.dll" (ByVal hmx As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As Long
Private Type MIXERCONTROL
cbStruct As Long
dwControlID As Long
dwControlType As Long
fdwControl As Long
cMultipleItems As Long
szShortName As String * MIXER_SHORT_NAME_CHARS
szName As String * MIXER_LONG_NAME_CHARS
lMinimum As Long
lMaximum As Long
reserved(10) As Long
End Type
Private Type MIXERCONTROLDETAILS
cbStruct As Long
dwControlID As Long
cChannels As Long
item As Long
cbDetails As Long
paDetails As Long
End Type
Private Type MIXERCONTROLDETAILS_UNSIGNED
dwValue As Long
End Type
Private Type MIXERLINE
cbStruct As Long
dwDestination As Long
dwSource As Long
dwLineID As Long
fdwLine As Long
dwUser As Long
dwComponentType As Long
cChannels As Long
cConnections As Long
cControls As Long
szShortName As String * MIXER_SHORT_NAME_CHARS
szName As String * MIXER_LONG_NAME_CHARS
dwType As Long
dwDeviceID As Long
wMid As Integer
wPid As Integer
vDriverVersion As Long
szPname As String * MAXPNAMELEN
End Type
Private Type MIXERLINECONTROLS
cbStruct As Long
dwLineID As Long
dwControl As Long
cControls As Long
cbmxctrl As Long
pamxctrl As Long
End Type
'Le volume est exprimé en pourcentage (entre 0 et 100)
'la fonction returne true si ca a fonctionné
Function SetVolume(VolumeLevel As Long) As Boolean
Dim hmx As Long
Dim uMixerLine As MIXERLINE
Dim uMixerControl As MIXERCONTROL
Dim uMixerLineControls As MIXERLINECONTROLS
Dim uDetails As MIXERCONTROLDETAILS
Dim uUnsigned As MIXERCONTROLDETAILS_UNSIGNED
Dim RetValue As Long
Dim hmem As Long
If VolumeLevel < 0 Or VolumeLevel > 100 Then GoTo error
RetValue = mixerOpen(hmx, 0, 0, 0, 0)
If RetValue <> MMSYSERR_NOERROR Then GoTo error
uMixerLine.cbStruct = Len(uMixerLine)
uMixerLine.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS
RetValue = mixerGetLineInfo(hmx, uMixerLine, _
MIXER_GETLINEINFOF_COMPONENTTYPE)
If RetValue <> MMSYSERR_NOERROR Then GoTo error
uMixerLineControls.cbStruct = Len(uMixerLineControls)
uMixerLineControls.dwLineID = uMixerLine.dwLineID
uMixerLineControls.dwControl = MIXERCONTROL_CONTROLTYPE_VOLUME
uMixerLineControls.cControls = 1
uMixerLineControls.cbmxctrl = Len(uMixerControl)
hmem = GlobalAlloc(&H40, Len(uMixerControl))
uMixerLineControls.pamxctrl = GlobalLock(hmem)
uMixerControl.cbStruct = Len(uMixerControl)
RetValue = mixerGetLineControls(hmx, uMixerLineControls, _
MIXER_GETLINECONTROLSF_ONEBYTYPE)
If RetValue <> MMSYSERR_NOERROR Then GoTo error
CopyMemory uMixerControl, ByVal uMixerLineControls.pamxctrl, _
Len(uMixerControl)
GlobalFree hmem
hmem = 0
uDetails.item = 0
uDetails.dwControlID = uMixerControl.dwControlID
uDetails.cbStruct = Len(uDetails)
uDetails.cbDetails = Len(uUnsigned)
hmem = GlobalAlloc(&H40, Len(uUnsigned))
uDetails.paDetails = GlobalLock(hmem)
uDetails.cChannels = 1
uUnsigned.dwValue = CLng((VolumeLevel * uMixerControl.lMaximum) / 100)
CopyMemory ByVal uDetails.paDetails, uUnsigned, Len(uUnsigned)
RetValue = mixerSetControlDetails(hmx, uDetails, _
MIXER_SETCONTROLDETAILSF_VALUE)
GlobalFree hmem
hmem = 0
If RetValue <> MMSYSERR_NOERROR Then GoTo error
mixerClose hmx
SetVolume = True
Exit Function
error:
' Une erreur s'est produite
If hmx <> 0 Then mixerClose hmx
If hmem Then GlobalFree hmem
SetVolume = False
End Function
Sources du même auteur
Sources de la même categorie
Commentaires et avis
|
Derniers Blogs
UNE JOLIE-HORLOGE ET PAS QU'UN PEU !UNE JOLIE-HORLOGE ET PAS QU'UN PEU ! par neodante
Pour les possesseurs d'iPhone, ça y est Bijin Tokei - qui se traduit littéralement en Français par " Jolie Horloge " - est arrivé et GRATUITEMENT s'il vous plaît ! Après la version Tokyo, Hokkaido, night club, racing, Gal, "pour les mademoiselles'", . voi...
Cliquez pour lire la suite de l'article par neodante TECHDAYS PARIS 2010 : CONNECTEZ VOS DONNéES à SHAREPOINT 2010 AVEC LES BUSINESS CONNECTIVITY SERVICESTECHDAYS PARIS 2010 : CONNECTEZ VOS DONNéES à SHAREPOINT 2010 AVEC LES BUSINESS CONNECTIVITY SERVICES par ROMELARD Fabrice
Animé par: Gaetan Bouveret et Julien Chomarat Business Connectivity Services (BCS) est dans SharePoint 2010 la version 2 de Business Data Catalog (BDC dans SharePoint 2007). Il s'agit de la solution permettant de visualiser des données provenan...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice [DIVERS] SUIVRE VOS SéRIES PRéFéRéS SUR LA TOILE[DIVERS] SUIVRE VOS SéRIES PRéFéRéS SUR LA TOILE par orion
Comme de nombreux geek, je suis un grand amateur de série TV et je rate régulièrement des épisodes de mes séries préférés. Une solution s'offre à vous avec ce merveilleux site : Tv Gorge - www.tvgorge.com Moteur de recherche à l'appui, vous pouvez ...
Cliquez pour lire la suite de l'article par orion TECHDAYS PARIS 2010 : LA BI DANS SHAREPOINT 2010TECHDAYS PARIS 2010 : LA BI DANS SHAREPOINT 2010 par ROMELARD Fabrice
Animé par: Vincent Bellet et Baptiste Giraudier La BI dans SharePoint 2010, Les nouveaux services d'application dans SP2010 et SQL Server Reporting services 2008 R2. La BI dans SharePoint est généralisée pour tous afin de permettre à tous les coll...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Logiciels
DB-MAIN (9.1.0)DB-MAIN (9.1.0)DB-MAIN is a data-modeling and data-architecture tool. It is designed to help developers and anal... Cliquez pour télécharger DB-MAIN Xilisoft DPG Convertisseur (5.1.37.0120)XILISOFT DPG CONVERTISSEUR (5.1.37.0120)Xilisoft DPG Convertisseur offre aux fans de Nintendo DS une bonne solution leur permettant de dé... Cliquez pour télécharger Xilisoft DPG Convertisseur GraphicsGale (2.01.01)GRAPHICSGALE (2.01.01)GraphicsGale est un logiciel de PixelArt avec de nombreuse fonctionnalités permettant de réalisé ... Cliquez pour télécharger GraphicsGale Architecte 3D (Platinum 2010)ARCHITECTE 3D (PLATINUM 2010)Architecte 3D Platinium vous permet de concevoir facilement les plans votre future maison, de l'é... Cliquez pour télécharger Architecte 3D TeamViewer 5 (TeamViewer 5)TEAMVIEWER 5 (TEAMVIEWER 5)Dépanner un ami,expliquer une manipulation devient un jeu d'enfant.
Prise en main d'un autre ord... Cliquez pour télécharger TeamViewer 5
Comparez les prix

HTC Hero
Entre 550€ et 550€
|