iŞiMizNeT.CoM Paylaşım Dostluk Bizim İşimiz

'basit ses ayar programı
'bir kaydırma cubuğu(Slider1)(textpozision=0 yapın)
've bir metin kutusu(Text1) ihtiyaç vardır.

Private Declare Function waveOutSetVolume Lib "Winmm" (ByVal wDeviceID As Integer, ByVal dwVolume As Long) As Integer
Private Declare Function waveOutGetVolume Lib "Winmm" (ByVal wDeviceID As Integer, dwVolume As Long) As Integer
Private Sub Command1_Click()
Dim a, i As Long
Dim tmp As String
a = waveOutGetVolume(0, i)
tmp = "&h" & Right(Hex$(i), 4)
Text1 = CLng(tmp)
End Sub



Private Sub Slider1_Scroll()
Dim a, i As Long
Dim tmp, vol As String
Slider1.Min = 0
Slider1.Max = 100



vol = Slider1.Value * 650
Text1 = Slider1.Value * 650
tmp = Right((Hex$(vol + 65536)), 4)
vol = CLng("&H" & tmp & tmp)
a = waveOutSetVolume(0, vol)


End Sub

tşk ederim işime yaradı

eyw. saolasın

eyws dasdasd