|
||||
|
|
#1 (permalink) |
|
Neofita della community ![]()
82 Messaggi
![]() |
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 |
|
|
|
|
|
#2 (permalink) |
|
Neofita della community ![]()
82 Messaggi
![]() |
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
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. |
|
|
|
|
|
#3 (permalink) |
|
Neofita della community ![]()
82 Messaggi
![]() |
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
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
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 |
|
|
|
![]() |
| Strumenti della discussione | |
| Modalità di visualizzazione | |
|
|
Tutti gli orari sono GMT +1. Attualmente sono le 10:31.







Modalità lineare

