Forma 1 tane modül, 6 tane label, 2 tane timer, 1 tane check kutusu, 2 tane slider kontrolü(Microsoft Common Control 6 - MSCOMCTL.OCX) ekleyin.
Kod: Tümünü seç
Option Explicit
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
End If
If (lpc.dwSupport And 4) = 0 Then
Slider1.Visible = False
Slider2.Visible = False
End If
If (lpc.dwSupport And 8) = 0 Then
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
Call waveOutGetVolume(0, x)
sol = x And &HFFFF&
st = Hex(x And &HFFFF0000)
If Len(st) > 4 Then
st = Mid(st, 1, Len(st) - 4)
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