-
I got this code from a thing at PlanetSourceCode.com, this is a simple program with 2 command buttons, a status bar, and a progress bar:
Code:
Dim q As String, ahgt, ghtr As String
Dim id As Long, v As Long, i As Long, lVol As lVolType, Vol As VolType, lv As Double, rv As Double
Private Declare Function auxGetVolume Lib "WINMM.DLL" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Private Declare Function mciGetDeviceID Lib "WINMM.DLL" Alias "mciGetDeviceIDA" (ByVal lpstrName As String) As Long
Private Declare Function waveOutGetVolume Lib "WINMM.DLL" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Private Declare Function waveOutSetVolume Lib "WINMM.DLL" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Type lVolType
v As Long
End Type
Private Type VolType
lv As Integer
rv As Integer
End Type
Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If q = "1" Then
Exit Sub
End If
id = -0
i = waveOutGetVolume(id, v)
lVol.v = v
LSet Vol = lVol
lv = Vol.lv: rv = Vol.rv
lv = lv - &HFFF
rv = rv - &HFFF
If lv < -32768 Then lv = 65535 + lv
If rv < -32768 Then rv = 65535 + rv
Vol.lv = lv
Vol.rv = rv
LSet lVol = Vol
v = lVol.v
i = waveOutSetVolume(id, v)
Call Findout
StatusBar1.SimpleText = ProgressBar1.Value
End Sub
Private Sub Command2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If q = "10" Then
Exit Sub
End If
Dim dfre
j = 1
id = -0
i = waveOutGetVolume(id, v)
lVol.v = v
LSet Vol = lVol
lv = Vol.lv: rv = Vol.rv
lv = lv + &HFFF
rv = rv + &HFFF
'If lv <= -30000 Then Exit Sub
If lv > 32767 Then lv = lv - 65536
If rv > 32767 Then rv = rv - 65536
Vol.lv = lv
Vol.rv = rv
LSet lVol = Vol
v = lVol.v
i = waveOutSetVolume(id, v)
Call Findout
StatusBar1.SimpleText = ProgressBar1.Value
End Sub
Private Sub Form_Load()
Call Findout
End Sub
Sub Findout()
id = -0
i = waveOutGetVolume(id, v)
lVol.v = v
LSet Vol = lVol
lv = Vol.lv: rv = Vol.rv
lv = lv - &HFFF
rv = rv - &HFFF
If lv < -32768 Then lv = 65535 + lv
If rv < -32768 Then rv = 65535 + rv
Vol.lv = lv
Vol.rv = rv
LSet lVol = Vol
v = lVol.v
ghtr = Left(lv, 1)
If ghtr = "-" Then
GoTo erre
End If
If lv < 5000 Then
q = 1
GoTo sayit
End If
If lv < 10000 Then
q = 2
GoTo sayit
End If
If lv < 15000 Then
q = 3
GoTo sayit
End If
If lv < 20000 Then
q = 4
GoTo sayit
End If
If lv < 25000 Then
q = 5
GoTo sayit
End If
If lv < 30000 Then
q = 6
GoTo sayit
End If
erre:
If lv < (-28000) Then
q = 7
GoTo sayit
End If
If lv < (-22000) Then
q = 8
GoTo sayit
End If
If lv < (-15000) Then
q = 9
GoTo sayit
End If
If lv < (-8000) Then
q = 10
GoTo sayit
End If
sayit:
ProgressBar1.Value = q
End Sub
how do i made it so that a slide bar controls the volume?
[Edited by dimava on 11-09-2000 at 10:25 PM]
-
I think that you have an event on the slider control (Slider_Change) and use this with the WaveOutSetVolume function
Possible E.g.
Private Sub Slider1_change()
Dim NewVol as long
NewVol=(slider1.value/10) * MaxVolumeVal
call WaveOutSetVolume(DeviceID,NewVol)
End Sub
I haven't tested this as I don't have a sound card at work, but this may help you sort the problem