Denetim masasindaki ses ayarini bilirsiniz iste bu da tipkisinin aynisi bence daha guzel bakalim farki fark edebilecek misiniz

1- Forma 1 tane modul, 6 tane label, 2 tane timer, 1 tane check kutusu, 2 tane slider kontrolu(MSCOMCTL.OCX) ekleyin.



""""""""""""""Module 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="alcak"
label4.caption="yuksek"
label5.caption="alcak"
label6.caption="yuksek"
check1.caption="Kaydirma Gostergeleri Ayni Anda Hareket Etsin"

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

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

If (lpc.dwSupport And 8) = 0 Then 'sol sag ses ayarini desteklemiyorsa birini gizle
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 'su anki seviyeyi goster
Call waveOutGetVolume(0, x)
sol = x And &HFFFF& 'dusuk seviyeli 2byte
st = Hex(x And &HFFFF0000)
If Len(st) > 4 Then
st = Mid(st, 1, Len(st) - 4) 'yuksek seviyeli 2 bayti al
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
__________________