Regler le volume sonore

Commenter

Contenu du snippet

Permet simplement de régler le volume sonore de windows

Ti£oi$

Source / Exemple : 


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

A voir également

S'inscrire maintenant

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.

Du même auteur (Tilois)