Bilgisayarın sesini Açıp Kapamak

1- Forma 1 tane modül, 6 tane label, 2 tane timer, 1 tane check kutusu, 2 tane slider kontrolü(MSCOMCTL.OCX) ekleyin.



''''''''''''''''''''''''''''Modüle eklenecek kisim''''''''''''''''''''''''''''

Public Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long

Public Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long

Public Const MAXPNAMELEN = 32 ' max product name length (including NULL)

Public Type WAVEOUTCAPS
wMid As Integer
wPid As Integer
vDriverVersion As Long
szPname As String * MAXPNAMELEN
dwFormats As Long
wChannels As Integer
dwSupport As Long
End Type

Public Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long

Public Declare Function waveOutGetDevCaps Lib "winmm.dll" Alias "waveOutGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As WAVEOUTCAPS, ByVal uSize As Long) As Long



''''''''''''''''''''''''''''''''''Forma eklenecek kisim'''''''''''''''''''''''''''''''''''''''




Private Sub Check1_Click()
Timer1.Interval = 0
Timer2.Interval = 0
End Sub

Private Sub Form_Load()

label1.caption="sag"
label2.caption="sol"
label3.caption="alçak"
label4.caption="yüksek"
label5.caption="alçak"
label6.caption="yüksek"
check1.caption="Kaydirma Göstergeleri Ayni Anda Hareket Etsin"

Dim lpc As WAVEOUTCAPS
If waveOutGetNumDevs() = 0 Then
MsgBox ("Ses çalacak donanmim yok")
End If
Call waveOutGetDevCaps(0, lpc, Len(lpc))
If lpc.wChannels = 0 Then
Slider2.Visible = False [m]'mono ise birini gizle[/m]
End If

If (lpc.dwSupport And 4) = 0 Then [m]'ses ayarini desteklemiyorsa ikisinide gizle[/m]
Slider1.Visible = False
Slider2.Visible = False
End If

If (lpc.dwSupport And = 0 Then [m]'sol sag ses ayarini desteklemiyorsa birini gizle[/m]
Slider2.Visible = False
End If

Slider1.Min = 0
Slider1.Max = &HFFFF&
Slider1.TickFrequency = &HFFFF& / 10
Slider2.Min = 0
Slider2.Max = &HFFFF&
Slider2.TickFrequency = &HFFFF& / 10


Dim x, sol, sag, st [m]'su anki seviyeyi göster[/m]
Call waveOutGetVolume(0, x)
sol = x And &HFFFF& [m]'düsük seviyeli 2byte[/m]
st = Hex(x And &HFFFF0000)
If Len(st) > 4 Then
st = Mid(st, 1, Len(st) - 4) [m]'yüksek seviyeli 2 bayti al[/m]
Else
st = 0
End If
sag = CDbl("&h" & st)
Slider1.Value = sol
Slider2.Value = sag
End Sub

Sub sesayar()
Dim x, sol, sag, s
sol = Slider1.Value
sag = Slider2.Value
s = Val("&h" & Hex(sag) & String(4 - Len(Hex(sol)), "0") & Hex(sol) & "&")
Call waveOutSetVolume(0, s)
End Sub

Private Sub Slider1_Click()
sesayar
End Sub

Private Sub Slider1_Scroll()
If Check1.Value = 0 Then
Else
Timer1.Interval = 0
Timer2.Interval = 1
End If
sesayar
End Sub

Private Sub Slider2_Click()
sesayar
End Sub

Private Sub Slider2_Scroll()
If Check1.Value = 0 Then
Else
Timer2.Interval = 0
Timer1.Interval = 1
End If
sesayar
End Sub

Private Sub Timer1_Timer()
Slider1 = Slider2
End Sub

Private Sub Timer2_Timer()
Slider2 = Slider1
End Sub