Questo codice:
Private Sub Slider1_Change()
Dim vol
vol = (CLng(Slider1.Width) / 2000) * micCtrl.lMaximum
SetVolumeControl hmixer, volCtrl, vol 'sets volume control on system to match scale bar
End Sub
Cosa dovrebbe fare?
perché
vol dovrebbe variare?? chi cambia la larghezza dello slider?? (Slider1.Width)
il valore dello slider cambia nella proprietà:
Slider1.Value che va letta nell'evento:
Slider1_Scroll()
Se usi win7 il codice seguente funziona, ma in win10, tutto è cambiato non puoi più usare vecchi codici VB6
Dim vol As Long
Dim cursore As Integer
Dim hmixer As Long ' mixer handle
Dim volCtrl As MIXERCONTROL ' waveout volume control
Private Declare Function mixerSetControlDetails Lib "winmm.dll" _
(ByVal hmxobj As Long, _
pmxcd As MIXERCONTROLDETAILS, _
ByVal fdwDetails As Long) As Long
Private Declare Sub CopyPtrFromStruct Lib "kernel32" _
Alias "RtlMoveMemory" _
(ByVal ptr As Long, _
struct As Any, _
ByVal cb 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
lMinimum As Long ' Minimum value
lMaximum As Long ' Maximum value
End Type
Private Type MIXERCONTROLDETAILS
cbStruct As Long ' size in Byte of MIXERCONTROLDETAILS
dwControlID As Long ' control id to get/set details on
cChannels As Long ' number of channels in paDetails array
item As Long ' hwndOwner or cMultipleItems
cbDetails As Long ' size of _one_ details_XX struct
paDetails As Long ' pointer to array of details_XX structs
End Type
Private Type MIXERCONTROLDETAILS_UNSIGNED
dwValue As Long ' value of the control
End Type
Private Sub Form_Load()
Slider1.Min = 22000 ' valore da aggiustare per il max volume
Slider1.Max = 0
End Sub
Private Sub Slider1_Scroll()
vol = Slider1.Value
cursore = Val(Text1.Text) ' solitamente il volume master = 1, ma non è detto
SetVolumeControl hmixer, volCtrl, vol, cursore
End Sub
Private Function SetVolumeControl(ByVal hmixer As Long, mxc As MIXERCONTROL, ByVal volume As Long, ByVal slider As Integer) As Boolean
'This function sets the value for a volume control. Returns True if successful
Dim mxcd As MIXERCONTROLDETAILS
Dim volu As MIXERCONTROLDETAILS_UNSIGNED
mxcd.item = 0
mxcd.dwControlID = slider 'mxc.dwControlID
mxcd.cbStruct = Len(mxcd)
mxcd.cbDetails = Len(vol)
' Allocate a buffer for the control value buffer
hmem = GlobalAlloc(&H40, Len(vol))
mxcd.paDetails = GlobalLock(hmem)
mxcd.cChannels = 1
volu.dwValue = volume * 3
' Copy the data into the control value buffer
CopyPtrFromStruct mxcd.paDetails, volu, Len(volu)
' Set the control value
rc = mixerSetControlDetails(hmixer, mxcd, MIXER_SETCONTROLDETAILSF_VALUE)
GlobalFree (hmem)
If (MMSYSERR_NOERROR = rc) Then
SetVolumeControl = True
Else
SetVolumeControl = False
End If
End Function
Guarda in Form1_Load e aggiusta il valore massimo
Ho aggiunto una textbox, perché non sai a priori il numero del cursore del mixer che devi variare, prova con valori tra 0 e 10
Audio.gif
Comunque anche in win7 possono sorgere delle situazioni impreviste, per avere la certezza che il codice funzioni ci vuole Win XP, oppure tanta pazienza e competenza.