THT DUYURU

Visual Basic Öğrenilmesi ve kullanışı kolay olan Visual Basic’in dökümanlarının ve open source projelerin paylaşım alanı.

takipci
chat
Seçenekler

Vb6 pc sesi kısma yükseltme

'eqwedelly - ait Kullanıcı Resmi (Avatar)
Üye
Üyelik tarihi:
01/2011
Nereden:
TÜRKİYE
Mesajlar:
204
Konular:
35
Teşekkür (Etti):
44
Teşekkür (Aldı):
7
Ticaret:
(0) %
1
1030
3 Hafta önce
#1
Vb6 pc sesi kısma yükseltme
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 kod
Kod:
 
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 
 
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 kodlar

Kod:
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 8) = 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
'eqwedelly - ait Kullanıcı Resmi (Avatar)
Üye
Üyelik tarihi:
01/2011
Nereden:
TÜRKİYE
Mesajlar:
204
Konular:
35
Teşekkür (Etti):
44
Teşekkür (Aldı):
7
Ticaret:
(0) %
3 Hafta önce
#2
Cevap: Vb6 pc sesi kısma yükseltme
Mscomctl.ocx buradan indirebilirsiniz indirmeden once system32 dosyalari icinde olacak oraya bakabilirsiniz https://www.ocxme.com/files/mscomctl_ocx

Bookmarks


« Önceki Konu | Sonraki Konu »
Seçenekler