MasterDrive.it   
Vai indietro   MasterDrive.it > Software Development > Visual Basic 6



Rispondi
 
Strumenti della discussione Modalità di visualizzazione
Vecchio 12-10-2009, 17:03   #1 (permalink)
Neofita della community

 
82 Messaggi

tralux novizio della comunita' ( + 10 )
Cambiare il device audio

Sto cercando/provando senza successo il cambio del device audio su un pc con 2 schede audio.

Il parametro che vorrei cambiare è quello che si trova sotto Control Pannel -> Sounds and Audio Devices Properties -> nel tab Audio dentro il box Sound Playback dovrei cambiare il Default Device

Sto tentando con winmm.dll ma non ho capito o almeno dalle prove da me fatte non si riesce a pilotarlo dal mixer, dovrebbe essere il wave ho trovato questa api in particolare waveOutSetPitch ma non so come usarla o meglio il secondo parametro in input da quale struttura la prendo ?

Mi potete dare una mano GRAZIE

tralux non è in linea   Bookmark and Share Rispondi quotando
Vecchio 15-10-2009, 11:53   #2 (permalink)
Neofita della community

 
82 Messaggi

tralux novizio della comunita' ( + 10 )
Unhappy

Ho elaborato il seguente codice andando a vedere MSDN e tutte le info relative, per cambiare il device della scheda audio.

In pratica ci sono 3 strutture in cui bisogna operare per i canali WaveOut che "spero" identificano e guidano le impostazioni che si possono vedere sul Control Pannel -> Sounds and Audio Devices Properties -> tab Audio -> box Sound Playback -> Default Device

Cambiare il parametro sopra citato dovrei pilotare il WaveOut "se ho interpretato bene MSDN" in un PC con più schede audio.

Dovrei fare ciò ma per ora senza successo la funzione WaveOutMessage mi ritorna 8 che nel MMSYSERR_ Constants vale MMSYSERR_NOTSUPPORTED ovvero funzione non supportata.

Vi metto il codice:

Utilizzo un tester che prende in un DLL con dentro le funzioni per la manipolazione del audio, in questa DLL ho il seguente codice che pilota audio:

Nelle dichiarazioni della DLL :

codice:
Option Explicit

'costanti
Const WAVE_FORMAT_PCM = 1
Const DRVM_MAPPER = &H2000
Const DRVM_MAPPER_PREFERRED_SET = (DRVM_MAPPER + 22) '&H2016
Const DRVM_MAPPER_PREFERRED_GET = (DRVM_MAPPER + 21)

Const WHDR_DONE = &H1
Const WHDR_PREPARED = &H2
Const WHDR_BEGINLOOP = &H4
Const WHDR_ENDLOOP = &H8
Const WHDR_INQUEUE = &H10

'api winmm.dll
'----------------------------
Private Declare Function waveOutGetNumDevs Lib "winmm" () As Long
Private Declare Function waveOutGetDevCaps Lib "winmm.dll" Alias "waveOutGetDevCapsA" _
    (ByVal uDeviceID As Long, lpCaps As WaveOutCaps, ByVal uSize As Long) As Long
Private Declare Function waveOutOpen Lib "winmm.dll" _
(ByRef lphWaveOut As Long, ByVal uDeviceID As Long, _
ByRef lpFormat As WaveFormatEx, ByVal dwCallback As Long, _
ByVal dwInstance As Long, ByVal dwFlags As Long) As Integer
Private Declare Function waveOutClose Lib "winmm" (ByVal WaveDeviceInputHandle As Long) As Long
Private Declare Function waveOutPrepareHeader Lib "winmm.dll" _
    (ByVal hWaveOut As Long, ByRef lpWaveOutHdr As WaveHdr, ByVal uSize As Long) As Long
Private Declare Function waveOutUnprepareHeader Lib "winmm.dll" _
    (ByVal InputDeviceHandle As Long, ByRef WaveHdrPointer As WaveHdr, ByVal WaveHdrStructSize As Long) As Long
Private Declare Function waveOutWrite Lib "winmm.dll" _
    (ByVal hWaveOut As Long, ByRef lpWaveOutHdr As WaveHdr, ByVal uSize As Long) As Long
Private Declare Function waveOutMessage Lib "winmm.dll" _
    (ByVal hWaveOut As Long, ByVal msg As Long, ByVal dw1 As Long, ByVal dw2 As Long) As Long
Private Declare Function waveOutGetID Lib "winmm.dll" (ByVal hWaveOut As Long, ByRef puDeviceId As Long) As Long

'strutture wave
'------------------------------
Private Type WaveOutCaps
    ManufacturerID As Integer
    ProductID As Integer
    DriverVersion As Long
    ProductName(1 To 32) As Byte
    Formats As Long
    Channels As Integer
    Reserved As Integer
    dwSupport As Long
End Type

Private Type WaveFormatEx
    FormatTag As Integer
    Channels As Integer
    SamplesPerSec As Long
    AvgBytesPerSec As Long
    BlockAlign As Integer
    BitsPerSample As Integer
    ExtraDataSize As Integer
End Type

Private Type WaveHdr
    lpData As Long
    dwBufferLength As Long
    dwBytesRecorded As Long
    dwUser As Long
    dwFlags As Long
    dwLoops As Long
    lpNext As Long
    Reserved As Long
End Type


'funzione che setta il device 
Public Function SetDeviceAudio(ByVal NomeSchedaAudio As String) As Boolean
    Dim indice As Integer
    Dim Caps As WaveOutCaps
    Dim sWaveAudio() As String
    Dim lRet As Long
    Dim DevHandle As Long
    Dim dw1 As Long
    Dim dw2 As Long
    
    On Error GoTo lblerrorSetDeviceAudio
    
    Static WaveFormat As WaveFormatEx

    For indice = 0 To waveOutGetNumDevs - 1
        ReDim Preserve sWaveAudio(indice)
        Call waveOutGetDevCaps(indice, Caps, Len(Caps))
        sWaveAudio(indice) = StrConv(Caps.ProductName, vbUnicode)
        
       'filtrano il nome della scheda audio dai meta caratteri
        sWaveAudio(indice) = Mid(sWaveAudio(indice), 1, Len(NomeSchedaAudio))
        sWaveAudio(indice) = Replace(sWaveAudio(indice), Chr(0), "")
        sWaveAudio(indice) = Replace(sWaveAudio(indice), Chr(1), "")
        sWaveAudio(indice) = Replace(sWaveAudio(indice), Chr(12), "")
        
        MsgBox NomeSchedaAudio & " - " & sWaveAudio(indice)
        If NomeSchedaAudio = sWaveAudio(indice) Then
           
           With WaveFormat
                .FormatTag = WAVE_FORMAT_PCM
                .Channels = 2
                .SamplesPerSec = 44100
                .BitsPerSample = 8
                .BlockAlign = (.Channels * .BitsPerSample) \ 8
                .AvgBytesPerSec = .BlockAlign * .SamplesPerSec
                .ExtraDataSize = 32 '0
           End With

           'apro il controllo wave
           lRet = waveOutOpen(DevHandle, indice, WaveFormat, 0, 0, 0)
           MsgBox lRet & " - " & DevHandle & " - " & indice
           
           lRet = waveOutGetID(DevHandle, dw1)
           
           
           Static Wave As WaveHdr
           Wave.lpData = VarPtr(WaveFormat)
           Wave.dwBufferLength = 2048 '512
           Wave.dwFlags = 0
           
           lRet = waveOutPrepareHeader(DevHandle, Wave, Len(Wave))
           lRet = waveOutWrite(DevHandle, Wave, Len(Wave))
           lRet = waveOutUnprepareHeader(DevHandle, Wave, Len(Wave))
           
           lRet = waveOutMessage(DevHandle, DRVM_MAPPER_PREFERRED_SET, dw1, 0)
           MsgBox "waveOutMessage:" & lRet & " - " & DevHandle
           
           lRet = waveOutClose(DevHandle)
           
           '---------------------------------------------------------------------
            
           SetDeviceAudio = True
           Exit For
        Else
           waveOutClose DevHandle
        End If
    Next indice
    
    Exit Function
    
lblerrorSetDeviceAudio:
    SetDeviceAudio = False

End Function
Utilizzo:
Nel progetto che collega la mia DLL uso un tasto che richiama il nome di tutte le schede audio del PC tramite le funzioni del mixer sempre della winmm.dll e popola con i nomi delle schede audio una lista (tali nomi sono uguali al Control Pannel -> Sounds and Audio Devices Properties -> tab Audio -> box Sound Playback -> Default Device).

Seleziono nella lista il nome del device che voglio cambiare ciò chiama la funzione SetDeviceAudio della mia DLL che in teoria cambia il device audio, ma ho il ritorno non corretto della waveOutMessage che se ho capito bene mi cambia il device audio o chiude il ciclo di operazioni per cambiare il device.

meccanismo:

1 con un for ciclo su tutte le Schede audio che rilevo waveOutGetNumDevs mi dice quante sono.
2 waveOutGetDevCaps passando la struttura WaveOutCaps ricavo tutte le info sulla scheda audio e il suo nome in byte.
3 nel mio caso particolare confronto i nomi così verifico che il device che sto cambiano sia quello selezionato in lista.
4 popolo la struttura WaveFormatEx.
5 faccio la open per la scheda audio scelta con waveOutOpen e qui ricavo il suo handle.
6 popolo la struttura WaveHdr.
7 preparo il buffer con i dati della nuova scheda audio con waveOutPrepareHeader,
scrivo in memoria le nuove strutture con waveOutWrite e la rilascio con waveOutUnprepareHeader.
8 chiamo la funzione waveOutMessage che dovrebbe cambiare il device nel pannello di controllo ma mi ritorna sempre non supportata.
9 chiudo con waveOutClose.

Dubbi che ho notato durante il funzionamento:

1 handle del audio non è mai fisso ma dinamico ogni volta che lancio applicazione.
2 la struttura WaveHdr impostando Wave.lpData sia con la struttura waveformat che con il devhandle sembra funzionare ugualmente , infatti quando eseguo i comandi waveOutPrepareHeader,waveOutWrite,waveOutUnprepare Header sento un suono audio che io interpreto come il cambio del device "forse mi sbaglio" e ciò mi fa pensare che la struttura WaveHdr la sto valorizando male o manca qualcosa.
3 la documentazione MSDN sulla valorizzazione della WaveHdr è poco chiara "almeno per me" dato che le funioni waveOutPrepareHeader,waveOutWrite e waveOutUnprepareHeader modificano il Wave.dwFlags che ne determina lo stato.
Si dovrebbe usare un "Do while Wave.dwFlags <> WHDR_DONE ... Loop" con le funzioni wave appena citate, ho notato che cmq non c'è un reale bisogno del loop ogni funzione cambia tale parametro della struttura WaveHdr e alla fine ho il WHDR_DONE, questo mi induce a pensare che mi manca qualche elemento determinante per il buon esito.

NB.: Anche se non ho ila segnalazione sul Control Pannel -> Sounds and Audio Devices Properties -> tab Audio -> box Sound Playback -> Default Device mi rimane settata la scheda audio di default infatti il sonoro della seconda scheda audio non mi funziona.

Qualche guru mi può aiutare a risolvere il problema ?
A questo punto non so più dove sbattere la testa.
GRAZIE

Ultima modifica di tralux : 15-10-2009 a 12:06.
tralux non è in linea   Bookmark and Share Rispondi quotando
Vecchio 22-10-2009, 09:30   #3 (permalink)
Neofita della community

 
82 Messaggi

tralux novizio della comunita' ( + 10 )
Smile soluzione

Ho risolto cetro non grazie alle API di windows che a volte ti fanno girare i cosiddetti cosi utilizando uno scritp esterno autoit simulo il cambio del device nel tab audio default device.

Dato che sono riuscito nel impresa grazie hai vari forum in internet metto a disposizione di tutti la classe completa che pilota quelle "merde" di device audio su WinXp con Vb6.

Classe:
codice:
Option Explicit

'costante che determina quale scrit viene lanciato per il cambio del device audio
Const PERCORSO_SCRIPT = "C:\ChangeSoundPlaybackDefaultDevice.exe"

'costanti MIXER per strutture e funzioni
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_GETCONTROLDETAILSF_VALUE = &H0&
Const MIXER_SETCONTROLDETAILSF_VALUE = &H0&
'Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = &H4
Const MIXERCONTROL_CONTROLTYPE_VOLUME = &H50030001
Const MIXERCONTROL_CT_CLASS_SWITCH = &H20000000
Const MIXERCONTROL_CT_UNITS_BOOLEAN = &H10000
Const MIXERCONTROL_CT_SC_SWITCH_BOOLEAN = &H0&
Const MIXERCONTROL_CONTROLTYPE_BOOLEAN = (MIXERCONTROL_CT_CLASS_SWITCH Or MIXERCONTROL_CT_SC_SWITCH_BOOLEAN Or MIXERCONTROL_CT_UNITS_BOOLEAN)
Const MIXERCONTROL_CONTROLTYPE_MUTE = (MIXERCONTROL_CONTROLTYPE_BOOLEAN + 2)

'-------------------------------------------------------------------------------------------------
'API Mixer
'-------------------------------------------------------------------------------------------------
'ottine il numero dei device audio presenti
Private Declare Function mixerGetNumDevs Lib "winmm.dll" () As Long
'apre il device audio e ne ottine handle
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
'ottine i dati per le strutture mixer
Private Declare Function mixerGetLineInfo Lib "winmm.dll" Alias _
    "mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, _
    ByVal fdwInfo As Long) As Long
'ottine i dati per le strutture mixer
Private Declare Function mixerGetLineControls Lib "winmm.dll" Alias _
    "mixerGetLineControlsA" (ByVal hmxobj As Long, pmxlc As MIXERLINECONTROLS, _
    ByVal fdwControls As Long) As Long
'ottine i dati per le strutture mixer
Private Declare Function mixerGetControlDetails Lib "winmm.dll" _
    Alias "mixerGetControlDetailsA" (ByVal hmxobj As Long, _
    pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
'setta i dati per le strutture mixer
Private Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj _
    As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
'chiude il mixer
Private Declare Function mixerClose Lib "winmm.dll" (ByVal hmx As Long) As Long
'copia le strutture in memoria
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, Source As Any, ByVal Length As Long)

'-------------------------------------------------------------------------------------------------
'API Wave (in uscita)
'-------------------------------------------------------------------------------------------------

'restituisce il numero dei device audio wave installati
Private Declare Function waveOutGetNumDevs Lib "winmm" () As Long
'restitusce i dati della struttra caps per il wave
Private Declare Function waveOutGetDevCaps Lib "winmm.dll" Alias "waveOutGetDevCapsA" _
    (ByVal uDeviceID As Long, lpCaps As WaveOutCaps, ByVal uSize As Long) As Long

'-------------------------------------------------------------------------------------------------
'API kernel32 (spostamento,allocazione,pulitura strutture/buffer in area di memoria RAM )
'-------------------------------------------------------------------------------------------------
'2 api per lo spostamento
Private Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" _
    (struct As Any, ByVal ptr As Long, ByVal cb As Long)
Private Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" _
    (ByVal ptr As Long, struct As Any, ByVal cb As Long)
'3 api per area di memoria
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

'-------------------------------------------------------------------------------------------------
'Strutture Mixer per API
'-------------------------------------------------------------------------------------------------

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

Private Type InfoSchedeAudio
    uMixerLine As MIXERLINE
    hMixerHandle As Long
    NomeSchedaAudio As String
End Type

'-------------------------------------------------------------------------------------------------
'Strutture Wave per API
'-------------------------------------------------------------------------------------------------

Private Type WaveOutCaps
    ManufacturerID As Integer
    ProductID As Integer
    DriverVersion As Long
    ProductName(1 To 32) As Byte
    Formats As Long
    Channels As Integer
    Reserved As Integer
    dwSupport As Long
End Type


Public Enum MUTE_CONTROL
    SPEAKER_MUTE = 7
    LINEIN_MUTE = 8
    MICROPHONE_MUTE = 9
    SYNTHESIZER_MUTE = 10
    COMPACTDISC_MUTE = 11
    WAVEOUT_MUTE = 12
    AUXILIARY_MUTE = 13
End Enum


'-------------------------------------------------------------------------------------------------
'Variabili globali a livello classe
'-------------------------------------------------------------------------------------------------
'presenza headphone
Private m_HeadPhonePresent As Boolean
Private b_HeadPhontEvent As Boolean
'utilizzo script esterni
Private ScriptAudio As IWshRuntimeLibrary.WshShell
'controllo mixer
Private tMixerControls(20) As MIXERCONTROL
'matrice con i dati periferiche audio
Private tSchedeAudio() As InfoSchedeAudio
'evento che rileva la presenza o meno delle cuffie
Public Event AudioHeadPhoneChange(ByVal HeadPhone As Boolean)
'collegamento alla DLL per il sensore hardware jack cuffie se è presente
Private oObj as oObj

'inizializzazione mixer schede audio
'
Private Sub Class_Initialize()
    Dim RetValue As Long
    Dim MixerNumber As Integer
    Dim hmx As Long
    Dim TmpMixerLine As MIXERLINE

    On Error GoTo lblerrorClass_Initialize
    
    b_HeadPhontEvent = False
    
    'qui dovete settare la variabile oggetto che punta alla DLL per il controllo del 
    'sensore hardware delle cuffie se è presente.
    'Set oObj = New oObj  'prendetelo come esempio

    Set ScriptAudio = New IWshRuntimeLibrary.WshShell

    'inizializzo la variabile interna con il valore attuale del FEP.HeadPhonePresent
    m_HeadPhonePresent = oFep.HeadPhonePresent
    hmx = 0
    For MixerNumber = 0 To mixerGetNumDevs - 1
        RetValue = mixerOpen(hmx, MixerNumber, 0, 0, 0)
        If RetValue <> MMSYSERR_NOERROR Then
           Err.Raise vbObjectError, "B3AudioHeadPhone", "Apertura driver mixer schede audio fallita"
           Exit Sub
        End If
        'per il set/get mute dei dispositivi audio mixer
        RetValue = GetMixerControl(hmx, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, MIXERCONTROL_CONTROLTYPE_MUTE, tMixerControls(SPEAKER_MUTE))
        TmpMixerLine.cbStruct = Len(TmpMixerLine)
        TmpMixerLine.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS
        RetValue = mixerGetLineInfo(hmx, TmpMixerLine, MIXER_GETLINEINFOF_COMPONENTTYPE)
        If RetValue = MMSYSERR_NOERROR Then
            'popolo array con i dati delle schede audio
            ReDim Preserve tSchedeAudio(MixerNumber)
            tSchedeAudio(MixerNumber).uMixerLine.cbStruct = TmpMixerLine.cbStruct
            tSchedeAudio(MixerNumber).uMixerLine.dwComponentType = TmpMixerLine.dwComponentType
            tSchedeAudio(MixerNumber).NomeSchedaAudio = Replace(TmpMixerLine.szPname, Chr(0), "")
            tSchedeAudio(MixerNumber).hMixerHandle = hmx
        End If
    Next MixerNumber
    
    Exit Sub
lblerrorClass_Initialize:
    Err.Raise vbObjectError, "B3AudioHeadPhone", "errore apertura mixer delle schede audio installate"
End Sub

Private Sub Class_Terminate()
    On Error Resume Next
    Set ScriptAudio = Nothing
    Set oObj = Nothing
    On Error GoTo 0
End Sub

'proprietà che mi dice se sono inserite le cuffie
'
Public Property Get HeadPhonePresent() As Boolean
    'qui va inserito la DLL che supporta la rilevazione delle cuffie se avete il sensore   'hardware presente sul jack
    HeadPhonePresent = m_HeadPhonePresent
End Property

'funzione che mi setta attivazione del evento inserimento cuffie
'
Public Function HeadPhoneDetectionEvent(ByVal bAttivo As Boolean) As Boolean
    b_HeadPhontEvent = bAttivo
    HeadPhoneDetectionEvent = True
End Function

'funzione che setta il volume master della scheda audio caricata
'
Public Function SetVolume(ByVal VolumeLevel As Long, sAudioDevice As String) As Boolean
    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
    Dim indice As Long

    On Error GoTo lblerrorSetVolume

    Class_Initialize


    ' VolumeLevel value considero i valori da 0 a 100
    If VolumeLevel < 0 Or VolumeLevel > 100 Then GoTo lblerrorSetVolume

    'recupero handle della scheda audio da usare
    For indice = LBound(tSchedeAudio) To UBound(tSchedeAudio)
        If tSchedeAudio(indice).NomeSchedaAudio = sAudioDevice Then
           Exit For
        End If
    Next indice

    'riapro il mixer della scheda audio selezionata
    RetValue = mixerGetLineInfo(tSchedeAudio(indice).hMixerHandle, tSchedeAudio(indice).uMixerLine, MIXER_GETLINEINFOF_COMPONENTTYPE)
    'If RetValue <> MMSYSERR_NOERROR Then GoTo lblerrorSetAudioLevel
    RetValue = mixerOpen(tSchedeAudio(indice).hMixerHandle, 0, 0, 0, 0)
    If RetValue <> MMSYSERR_NOERROR Then GoTo lblerrorSetVolume
    
    ' Initializzo MIXERLINECONTROLS strucure e chiamo mixerGetLineControls
    uMixerLineControls.cbStruct = Len(uMixerLineControls)
    uMixerLineControls.dwLineID = tSchedeAudio(indice).uMixerLine.dwLineID    'uMixerLine.dwLineID
    uMixerLineControls.dwControl = MIXERCONTROL_CONTROLTYPE_VOLUME
    uMixerLineControls.cControls = 1
    uMixerLineControls.cbmxctrl = Len(uMixerControl)

    ' Preparo il buffer a ricevere le proprietà del volume master
    ' e metto l'indirizzo nel uMixerLineControls.pamxctrl
    hmem = GlobalAlloc(&H40, Len(uMixerControl))
    uMixerLineControls.pamxctrl = GlobalLock(hmem)
    uMixerControl.cbStruct = Len(uMixerControl)
    RetValue = mixerGetLineControls(tSchedeAudio(indice).hMixerHandle, uMixerLineControls, _
        MIXER_GETLINECONTROLSF_ONEBYTYPE)
    If RetValue <> MMSYSERR_NOERROR Then GoTo lblerrorSetVolume
        
    ' Copio i dati del  buffer nella struttura uMixerControl
    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)


    'Allocare un buffer in cui proprietà per il controllo del volume sono riportati
    'e mettere il suo indirizzo in uDetails.paDetails
    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)

    ' Setto il nuovo volume
    RetValue = mixerSetControlDetails(tSchedeAudio(indice).hMixerHandle, uDetails, _
        MIXER_SETCONTROLDETAILSF_VALUE)
    GlobalFree hmem
    hmem = 0

    If RetValue <> MMSYSERR_NOERROR Then GoTo lblerrorSetVolume

    mixerClose tSchedeAudio(indice).hMixerHandle

    SetVolume = True
    Exit Function

lblerrorSetVolume:
    If tSchedeAudio(indice).hMixerHandle <> 0 Then mixerClose tSchedeAudio(indice).hMixerHandle
    If hmem Then GlobalFree hmem
    SetVolume = False
End Function

'funzione che restituisce un array di stringhe con il nome delle schede audio istallate
'
Public Function GetDeviceAudio() As String()
     Dim sSchedeAudio() As String
     Dim indice As Integer
             
     For indice = 0 To UBound(tSchedeAudio)
         ReDim Preserve sSchedeAudio(indice)
         sSchedeAudio(indice) = tSchedeAudio(indice).NomeSchedaAudio
     Next
     GetDeviceAudio = sSchedeAudio
End Function

'funzione che setta un diverso driver audio
'
Public Function SetPlayBackDefaultDevice(ByVal sAudioDevice As String) As Long
    Dim indice As Integer
    Dim lRet As Long
    Dim sWaveAudio() As String
    Dim Caps As WaveOutCaps
        
    On Error GoTo lblerrorSetPlayBackDefaultDevice
    
    'controllo che il device è corretto
    For indice = 0 To waveOutGetNumDevs - 1
        waveOutGetDevCaps indice, Caps, Len(Caps)
        'recupero tutti i nomi delle schede audio installate
        ReDim Preserve sWaveAudio(indice)
        sWaveAudio(indice) = StrConv(Caps.ProductName, vbUnicode)
        sWaveAudio(indice) = Mid(sWaveAudio(indice), 1, Len(sAudioDevice))
        sWaveAudio(indice) = Replace(sWaveAudio(indice), Chr(0), "")
        sWaveAudio(indice) = Replace(sWaveAudio(indice), Chr(1), "")
        sWaveAudio(indice) = Replace(sWaveAudio(indice), Chr(12), "")
        'cerco quella passata come parametro
        If sWaveAudio(indice) = sAudioDevice Then
            lRet = ScriptAudio.Run(PERCORSO_SCRIPT & " " & sAudioDevice, 7, True)
            If lRet <> 0 Then
               SetPlayBackDefaultDevice = lRet
               Exit Function
            End If
            Exit For
        End If
    Next indice
    SetPlayBackDefaultDevice = 0
    Exit Function
    
lblerrorSetPlayBackDefaultDevice:
    'setto io errore per un crash software
    SetPlayBackDefaultDevice = 99
End Function

'setta il mute del master volume della scheda audio passata per parametro
'
Public Function SetMute(ByVal sAudioDevice As String, ByVal bMuteState As Boolean) As Boolean
    Dim lMute As Long
    Dim indice As Integer
    Dim Control As MUTE_CONTROL
    
    Class_Initialize
    
    Control = SPEAKER_MUTE
    For indice = LBound(tSchedeAudio) To UBound(tSchedeAudio)
        If tSchedeAudio(indice).NomeSchedaAudio = sAudioDevice Then
           lMute = Abs(bMuteState)
           SetMute = SetControlValue(tSchedeAudio(indice).hMixerHandle, tMixerControls(Control), lMute)
           'MsgBox "setta audio:" & tSchedeAudio(indice).NomeSchedaAudio
           Exit For
        End If
    Next indice
End Function

'mi dice se è attivo il mute sul master volume della scheda audio passata per parametro
'
Public Function GetMute(ByVal sAudioDevice As String) As Boolean
    Dim indice As Integer
    Dim Control As MUTE_CONTROL

    For indice = LBound(tSchedeAudio) To UBound(tSchedeAudio)
        If tSchedeAudio(indice).NomeSchedaAudio = sAudioDevice Then Exit For
    Next indice
    Control = SPEAKER_MUTE
    
    GetMute = CBool(-GetControlValue(tSchedeAudio(indice).hMixerHandle, tMixerControls(Control)))
End Function

'------------------------------------------------------------------------------------------------------------
'evento del software che gestisce il sensore hardware delle cuffie  
'come detto solo se avete il suddeto sensore hardware nella documentazione della macchiana avrete pure le indicazoni di quale DLL rirarvi dentro al codice.

Private Sub oObj_HeadPhonePresentChanged(ByVal HeadPhonePresent As Boolean)
    If b_HeadPhontEvent Then RaiseEvent AudioHeadPhoneChange(HeadPhonePresent)
End Sub

'------------------------------------------------------------------------------------------------------------
'funzioni interne per mute mixer

Private Function GetControlValue(ByVal hmixer As Long, mxc As MIXERCONTROL) As Long
    'Funzione che valorizza il valore di control.

    Dim mxcd    As MIXERCONTROLDETAILS
    Dim vol     As MIXERCONTROLDETAILS_UNSIGNED
    Dim hmem    As Long
    Dim ret     As Long

    mxcd.item = 0
    mxcd.dwControlID = mxc.dwControlID
    mxcd.cbStruct = Len(mxcd)
    mxcd.cbDetails = Len(vol)

    hmem = GlobalAlloc(&H40, Len(vol))
    mxcd.paDetails = GlobalLock(hmem)
    mxcd.cChannels = 1

    'leggo il valore di control
    ret = mixerGetControlDetails(hmixer, mxcd, MIXER_GETCONTROLDETAILSF_VALUE)

    'copia i dati nel buffer di control
    CopyStructFromPtr vol, mxcd.paDetails, Len(vol)

    If mxc.lMaximum > 100 Then
        GetControlValue = (vol.dwValue * 100) / mxc.lMaximum - mxc.lMinimum
    Else
        GetControlValue = vol.dwValue
    End If

    GlobalFree (hmem)

End Function

Private Function SetControlValue(ByVal hmixer As Long, mxc As MIXERCONTROL, ByVal NewVolume As Long) As Boolean
    
    'Setta il valore di control.
                              
    Dim mxcd    As MIXERCONTROLDETAILS
    Dim vol     As MIXERCONTROLDETAILS_UNSIGNED
    Dim hmem    As Long
    Dim ret     As Long

    mxcd.item = 0
    mxcd.dwControlID = mxc.dwControlID
    mxcd.cbStruct = Len(mxcd)
    mxcd.cbDetails = Len(vol)

    'Alloca un buffer per il valore del buffer di control.
    hmem = GlobalAlloc(&H40, Len(vol))
    mxcd.paDetails = GlobalLock(hmem)
    mxcd.cChannels = 1

    ' valore di setup, usa la percentuale del range se il massimo è piu grande di 100
    If mxc.lMaximum > 100 Then
        vol.dwValue = NewVolume * (mxc.lMaximum \ 100)
    Else
        vol.dwValue = NewVolume
    End If
    If vol.dwValue > mxc.lMaximum Then vol.dwValue = mxc.lMaximum
    If vol.dwValue < mxc.lMinimum Then vol.dwValue = mxc.lMinimum

    ' copia i dati nel valore del buffer di control
    CopyPtrFromStruct mxcd.paDetails, vol, Len(vol)
         
    ' setta il valore di control
    ret = mixerSetControlDetails(hmixer, mxcd, MIXER_SETCONTROLDETAILSF_VALUE)
    GlobalFree (hmem)

    If ret = MMSYSERR_NOERROR Then SetControlValue = True
    
End Function

Private Function GetMixerControl(ByVal hmixer As Long, ByVal componentType As Long, ByVal ctrlType As Long, ByRef mxc As MIXERCONTROL) As Long
                              
    ' Questa funzione tenta di ottenere un controllo del mixer.
    Dim mxlc        As MIXERLINECONTROLS
    Dim mxl         As MIXERLINE
    Dim hmem        As Long
    Dim ret         As Long
             
    mxl.cbStruct = Len(mxl)
    mxl.dwComponentType = componentType
    
    ' Ottiene la linea corrispondente al tipo di componente
    ret = mixerGetLineInfo(hmixer, mxl, MIXER_GETLINEINFOF_COMPONENTTYPE)
         
    If ret = MMSYSERR_NOERROR Then
        mxlc.cbStruct = Len(mxlc)
        mxlc.dwLineID = mxl.dwLineID
        mxlc.dwControl = ctrlType
        mxlc.cControls = 1
        mxlc.cbmxctrl = Len(mxc)
             
        ' Alloca un buffer per il control
        hmem = GlobalAlloc(&H40, Len(mxc))
        mxlc.pamxctrl = GlobalLock(hmem)
        mxc.cbStruct = Len(mxc)
             
        ' restituisce il control
        ret = mixerGetLineControls(hmixer, mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE)
                  
        If ret = MMSYSERR_NOERROR Then
            GetMixerControl = True
                 
            ' Copia il control nella struttura di destinazione
            CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
        Else
            GetMixerControl = False
        End If
        GlobalFree (hmem)
        Exit Function
    End If
      
    GetMixerControl = False
    
End Function
Lo scrit fatto in autoit è il seguente:


codice:
$ret = 1
If $CmdLine[0] > 0 Then
	$pid = Run("control.exe mmsys.cpl,,2")
	If $pid = 0 Then
		$ret = 2
    Else 		
		$rc = WinWait("[CLASS:#32770]","",5)
		If $rc = 0 Then 
			$ret = 3
		Else
			;WinMove("[CLASS:#32770]","",-10000,-10000)
			$rc = controlsend("[CLASS:#32770]","","[CLASS:ComboBox; INSTANCE:1]",$CmdLine[1]) 
			If $rc = 0 Then 
				$ret = 4
			Else 	
				$rc = controlclick("[CLASS:#32770]","","[CLASS:Button; INSTANCE:11]")
				If $rc = 0 Then 
					$ret = 5 	
				Else 	
					$ret = 0
				Endif 	
			EndIf 
		EndIf  	
	EndIf 	
EndIf
Exit $ret
Compilate con autoit e create exe dello script mettete il codice della classe in una DLL o OCX createvi un tester e avrete il controllo del volume,mute,rilevamento cuffie inserite o meno (sempre a fronte del sensore hardware) e cambio del device audio in caso di più di una scheda audio presente.

Eventuali evoluzioni le trovate in rete dato che ho importato solo lo stretto necessario la winmm.dll (per winXp) ha oltre 40 funzioni per impazzirci sopra.

Auguri
tralux non è in linea   Bookmark and Share Rispondi quotando
Rispondi

Strumenti della discussione
Modalità di visualizzazione

Regole d'invio
Non puoi inserire discussioni
Non puoi inserire repliche
Non puoi inserire allegati
Non puoi modificare i tuoi messaggi

BB code è attivo
Le smilies sono attive
Il codice IMG è attivo
il codice HTML è disattivato
Trackbacks are attivo
Pingbacks are attivo
Refbacks are disattivato

Salto del forum


Tutti gli orari sono GMT +1. Attualmente sono le 10:31.


Powered by vBulletin versione 3.8.0
Copyright © 2000 - 2010, Jelsoft Enterprises Ltd.
Content Relevant URLs by vBSEO 3.2.0

Valid XHTML 1.0 Transitional  Creative Commons License

Eccetto dove diversamente specificato, i contenuti pubblicati in questa comunità sono rilasciati sotto Licenza
Creative Commons Attribuzione-Non commerciale-Condividi allo stesso modo 2.5 Italia License.
La comunita' di MasterDrive.it non e' responsabile di eventuali imprecisioni presenti nelle pagine.