Favorilerine Ekle | Giriş Sayfan Yap | Tavsiye Et

 

Kurs Tanıtım Sayfası | Süper Üye Kimdir? | Menü Tasarımı Konulu Örnek Ders
Kod İndir| Hazır Kodlar | Makaleler| İpuçları | VB .NET Kursu | Dersler | Forum | Alt Bölümler | Servisler
    Merhaba Misafir
    Anasayfa » Forum Anasayfa » Kategori: Visual Basic 6.0
Üye Girişi
Kullanıcı Adı:  
Şifre : 
Kaydet ?
Siteden tam olarak faydalanabilmek için üye olmalısınız.
Unuttuğunuz şifrenizi öğrenebilmek için kayıt sırasında verdiğiniz Hatırlatma Cevabı'nı bilmeniz gereklidir.
Şifre hatırlatma işlevini sadece 3 defa kullanma hakkınız vardır.
Kullanıcı adını ve şifresini unutan üyelere email ile yardım verilmez.

Aktivasyon Gelmedi mi?Aktivasyon mesajınız email adresinize gelmedi mi?
Buraya tıklayarak bir kez daha aktivasyon mesajı gönderilmesini sağlayabilirsiniz.
Lütfen email hesabınızın BULK ve SPAM klasörlerini de kontrol ediniz.
Rastgele Makale

VISUAL BASIC ?LE B?LE?EN HAZIRLAMA

Yazar: aavci
Control haz?rlama ve ocx yap?m?na dair temel bilgiler.


Webmasterlar
Sitenize Ekleyin!
Sitenizde "Son Eklenen 10 Visual Basic Yazısı"'nı göstermek ve içeriğini zenginleştirmek için buraya tıklayınız.

Vbasicmaster.com'a link verin!
Aşağıdaki minik banneri sitenize eklemek için tıklayın!

Üye Sayısı:
Ziyaretçiler nerede?

"win 7 ses sorunu"

win 7 de sesi nasıl azaltıp çoğaltabilirim xp de oluyor fakat win 7 de yazdığım kod geçersiz kalıyor.

Üyeye Özelden Mesaj At cobainbass | 13.09.2011 13:13


.exe yapıp başka bir pc'de mi denedin? Eğer öyle bir şey yaptıysan kendi pc'in xp ise denedigin pc'de win7 ise .dll eksik oldugu için olmuyordur

Üyeye Özelden Mesaj At mansur54 | 13.09.2011 18:53

dostum zaten win 7 de yazıom.

Üyeye Özelden Mesaj At cobainbass | 13.09.2011 20:08
Merhaba,

XP'de çalışıp da Win 7'de çalışmayan kodu yazabilir misin?

Sağol.

Üyeye Özelden Mesaj At scorpio3713 | 13.09.2011 21:06
Private Sub Form_Load()
Show
Slider1.Value = GetVolume
End Sub

Private Sub Slider1_Change()
SetVolume Slider1.Value
End Sub
Private Sub Slider1_Scroll()
Slider1_Change
End Sub


.......modül........


Option Explicit

Private hMixerHandle As Long
Private uMixerControls(20) As MIXERCONTROL

Private Const MMSYSERR_NOERROR = 0
Private Const MAXPNAMELEN = 32
Private Const MIXER_LONG_NAME_CHARS = 64
Private Const MIXER_SHORT_NAME_CHARS = 16
Private Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
Private Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
Private Const MIXER_SETCONTROLDETAILSF_VALUE = &H0&
Private Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
Private Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = &H4
Private Const MIXERCONTROL_CONTROLTYPE_VOLUME = &H50030001
Private Const MIXER_GETCONTROLDETAILSF_VALUE = &H0&

Private Declare Function mixerOpen Lib "winmm.dll" (phmx As Long, _
ByVal uMxId As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, _
ByVal fdwOpen As Long) As Long
Private Declare Function mixerGetLineInfo Lib "winmm.dll" Alias _
"mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, _
ByVal fdwInfo As Long) As Long
Private Declare Function mixerGetLineControls Lib "winmm.dll" Alias _
"mixerGetLineControlsA" (ByVal hmxobj As Long, pmxlc As MIXERLINECONTROLS, _
ByVal fdwControls As Long) As Long
Private Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj _
As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
Private Declare Function mixerClose Lib "winmm.dll" (ByVal hmx As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long

Private Declare Function mixerGetNumDevs Lib "winmm.dll" () As Long
Private Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long)
Private Declare Function mixerGetControlDetails Lib "winmm.dll" Alias "mixerGetControlDetailsA" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long

Public Enum VOL_CONTROL
SPEAKER = 0
End Enum

Private Type MIXERCONTROL
cbStruct As Long
dwControlID As Long
dwControlType As Long
fdwControl As Long
cMultipleItems As Long
szShortName As String * MIXER_SHORT_NAME_CHARS
szName As String * MIXER_LONG_NAME_CHARS
lMinimum As Long
lMaximum As Long
RESERVED(10) As Long
End Type

Private Type MIXERCONTROLDETAILS
cbStruct As Long
dwControlID As Long
cChannels As Long
item As Long
cbDetails As Long
paDetails As Long
End Type

Private Type MIXERCONTROLDETAILS_UNSIGNED
dwValue As Long
End Type

Private Type MIXERLINE
cbStruct As Long
dwDestination As Long
dwSource As Long
dwLineID As Long
fdwLine As Long
dwUser As Long
dwComponentType As Long
cChannels As Long
cConnections As Long
cControls As Long
szShortName As String * MIXER_SHORT_NAME_CHARS
szName As String * MIXER_LONG_NAME_CHARS
dwType As Long
dwDeviceID As Long
wMid As Integer
wPid As Integer
vDriverVersion As Long
szPname As String * MAXPNAMELEN
End Type

Private Type MIXERLINECONTROLS
cbStruct As Long
dwLineID As Long
dwControl As Long
cControls As Long
cbmxctrl As Long
pamxctrl As Long
End Type

Public Function SetVolume(VolumeLevel As Long) As Boolean
Dim hmx As Long
Dim uMixerLine As MIXERLINE
Dim uMixerControl As MIXERCONTROL
Dim uMixerLineControls As MIXERLINECONTROLS
Dim uDetails As MIXERCONTROLDETAILS
Dim uUnsigned As MIXERCONTROLDETAILS_UNSIGNED
Dim RetValue As Long
Dim hMem As Long

' VolumeLevel value must be between 0 and 100
If VolumeLevel < 0 Or VolumeLevel > 100 Then GoTo error

' Open the mixer
RetValue = mixerOpen(hmx, 0, 0, 0, 0)
If RetValue <> MMSYSERR_NOERROR Then GoTo error

' Initialize MIXERLINE structure and call mixerGetLineInfo
uMixerLine.cbStruct = Len(uMixerLine)
uMixerLine.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS
RetValue = mixerGetLineInfo(hmx, uMixerLine, _
MIXER_GETLINEINFOF_COMPONENTTYPE)
If RetValue <> MMSYSERR_NOERROR Then GoTo error

' Initialize MIXERLINECONTROLS strucure and
' call mixerGetLineControls
uMixerLineControls.cbStruct = Len(uMixerLineControls)
uMixerLineControls.dwLineID = uMixerLine.dwLineID
uMixerLineControls.dwControl = MIXERCONTROL_CONTROLTYPE_VOLUME
uMixerLineControls.cControls = 1
uMixerLineControls.cbmxctrl = Len(uMixerControl)

' Allocate a buffer to receive the properties of the master volume control
' and put his address into uMixerLineControls.pamxctrl
hMem = GlobalAlloc(&H40, Len(uMixerControl))
uMixerLineControls.pamxctrl = GlobalLock(hMem)
uMixerControl.cbStruct = Len(uMixerControl)
RetValue = mixerGetLineControls(hmx, uMixerLineControls, _
MIXER_GETLINECONTROLSF_ONEBYTYPE)
If RetValue <> MMSYSERR_NOERROR Then GoTo error

' Copy data buffer into the uMixerControl structure
CopyMemory uMixerControl, ByVal uMixerLineControls.pamxctrl, _
Len(uMixerControl)
GlobalFree hMem
hMem = 0

uDetails.item = 0
uDetails.dwControlID = uMixerControl.dwControlID
uDetails.cbStruct = Len(uDetails)
uDetails.cbDetails = Len(uUnsigned)

' Allocate a buffer in which properties for the volume control are set
' and put his address into uDetails.paDetails
hMem = GlobalAlloc(&H40, Len(uUnsigned))
uDetails.paDetails = GlobalLock(hMem)
uDetails.cChannels = 1
uUnsigned.dwValue = CLng((VolumeLevel * uMixerControl.lMaximum) / 100)
CopyMemory ByVal uDetails.paDetails, uUnsigned, Len(uUnsigned)

' Set new volume level
RetValue = mixerSetControlDetails(hmx, uDetails, _
MIXER_SETCONTROLDETAILSF_VALUE)
GlobalFree hMem
hMem = 0
If RetValue <> MMSYSERR_NOERROR Then GoTo error

mixerClose hmx
' signal success
SetVolume = True
Exit Function

error:
' An error occurred

' Release resources
If hmx <> 0 Then mixerClose hmx
If hMem Then GlobalFree hMem
' signal failure
SetVolume = False
End Function

Public Function GetVolume() As Long
OpenMixer (0)
If GetVolumeP(SPEAKER) >= 0 Or GetVolumeP(SPEAKER) <= 100 Then
GetVolume = GetVolumeP(SPEAKER)
Else
GetVolume = 0
End If
CloseMixer
End Function


Public Function OpenMixer(ByVal MixerNumber As Long) As Long
Dim ret As Long
' is there a mixer available?
If MixerNumber < 0 Or MixerNumber > mixerGetNumDevs - 1 Then Exit Function

' open the mixer
ret = mixerOpen(hMixerHandle, MixerNumber, 0, 0, 0)
If ret <> MMSYSERR_NOERROR Then Exit Function

' get the primary line controls by name, (this does not get all of the controls).

' speaker (master) volume
ret = GetMixerControl(hMixerHandle, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, MIXERCONTROL_CONTROLTYPE_VOLUME, uMixerControls(SPEAKER))
' return the mixer handle
OpenMixer = True
End Function

Private Function CloseMixer() As Long
CloseMixer = mixerClose(hMixerHandle)
hMixerHandle = 0
End Function

Private Function GetVolumeP(Control As VOL_CONTROL) As Long
GetVolumeP = GetControlValue(hMixerHandle, uMixerControls(Control))
End Function

Private Function GetMixerControl(ByVal hMixer As Long, ByVal componentType As Long, ByVal ctrlType As Long, ByRef mxc As MIXERCONTROL) As Long
' This function attempts to obtain a mixer control. Returns True if successful.
Dim mxlc As MIXERLINECONTROLS
Dim mxl As MIXERLINE
Dim hMem As Long
Dim ret As Long

mxl.cbStruct = Len(mxl)
mxl.dwComponentType = componentType

' Obtain a line corresponding to the component type
ret = mixerGetLineInfo(hMixer, mxl, MIXER_GETLINEINFOF_COMPONENTTYPE)

If ret = MMSYSERR_NOERROR Then
mxlc.cbStruct = Len(mxlc)
mxlc.dwLineID = mxl.dwLineID
mxlc.dwControl = ctrlType
mxlc.cControls = 1
mxlc.cbmxctrl = Len(mxc)

' Allocate a buffer for the control
hMem = GlobalAlloc(&H40, Len(mxc))
mxlc.pamxctrl = GlobalLock(hMem)
mxc.cbStruct = Len(mxc)

' Get the control
ret = mixerGetLineControls(hMixer, mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE)

If ret = MMSYSERR_NOERROR Then
GetMixerControl = True

' Copy the control into the destination structure
CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
Else
GetMixerControl = False
End If
GlobalFree (hMem)
Exit Function
End If

GetMixerControl = False
End Function

Private Function GetControlValue(ByVal hMixer As Long, mxc As MIXERCONTROL) As Long
'This function gets the value for a control.

Dim mxcd As MIXERCONTROLDETAILS
Dim vol As MIXERCONTROLDETAILS_UNSIGNED
Dim hMem As Long
Dim ret As Long

mxcd.item = 0
mxcd.dwControlID = mxc.dwControlID
mxcd.cbStruct = Len(mxcd)
mxcd.cbDetails = Len(vol)

hMem = GlobalAlloc(&H40, Len(vol))
mxcd.paDetails = GlobalLock(hMem)
mxcd.cChannels = 1

' Get the control value
ret = mixerGetControlDetails(hMixer, mxcd, MIXER_GETCONTROLDETAILSF_VALUE)

' Copy the data into the control value buffer
CopyStructFromPtr vol, mxcd.paDetails, Len(vol)

If mxc.lMaximum > 100 Then
GetControlValue = (vol.dwValue * 100) / mxc.lMaximum - mxc.lMinimum
Else
GetControlValue = vol.dwValue
End If

GlobalFree (hMem)
End Function

Üyeye Özelden Mesaj At cobainbass | 13.09.2011 21:17

Merhaba,

Çoğu zaman dizüstü bilgisayar kullanıyoruz...
eğer biz dizüstü bilgisayar kullanıyorsan bir mixer component olmayabilir...
OpenMixer fonksiyonunu aşağıdaki şekilde değiştirip bana sonucu söyler misin?

Public Function OpenMixer(ByVal MixerNumber As Long) As Long
Dim ret As Long
' is there a mixer available?
If MixerNumber < 0 Or MixerNumber > mixerGetNumDevs - 1 Then
Msgbox "Karıştırıcı mevcut değil...", vbinformation, "..:: BİLGİ ::.."
Exit Function
End If

' open the mixer
ret = mixerOpen(hMixerHandle, MixerNumber, 0, 0, 0)
If ret <> MMSYSERR_NOERROR Then Exit Function

' get the primary line controls by name, (this does not get all of the controls).

' speaker (master) volume
ret = GetMixerControl(hMixerHandle, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, MIXERCONTROL_CONTROLTYPE_VOLUME, uMixerControls(SPEAKER))
' return the mixer handle
OpenMixer = True
End Function

Üyeye Özelden Mesaj At scorpio3713 | 13.09.2011 22:33
tamamdır dostum başka bi yöntemle hallettim biraz acemice ve zor oldu ama olsun yinede denicem kardeşim senin söylediğini.

Üyeye Özelden Mesaj At cobainbass | 13.09.2011 22:52
İlla ki API deneyeceğim diyorsan eğer;
Yeni nesil API'lerden denemelisin Win7 veya Vista için...
Bir class oluşturup aşağıdaki kodları yapıştırarak kullanmaya başlayabilirsin.

Kolay gelsin.

Option Explicit

Private Const CLSCTX_INPROC_SERVER As Long = &H1&
Private Const CLSCTX_INPROC_HANDLER As Long = &H2&
Private Const CLSCTX_LOCAL_SERVER As Long = &H4&
Private Const CLSCTX_REMOTE_SERVER As Long = &H10&
Private Const CLSCTX_ALL As Long = CLSCTX_INPROC_SERVER Or _
CLSCTX_INPROC_HANDLER Or _
CLSCTX_LOCAL_SERVER Or _
CLSCTX_REMOTE_SERVER
Private Const CLSID_MyContext As String = "{5929DCA2-52B8-449B-8A58-FDF6750634DA}"
Private Const CLSID_MMDeviceEnumerator As String = "{BCDE0395-E52F-467C-8E3D-C4579291692E}"
Private Const IID_IMMDeviceEnumerator As String = "{A95664D2-9614-4F35-A746-DE8DB63617E6}"
Private Const IID_IAudioEndpointVolume As String = "{5CDF2C82-841E-4546-9722-0CF74078229A}"

Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Private Enum ERole
eConsole
eMultimedia
eCommunications
ERole_enum_count
End Enum

Private Enum EDataFlow
eRender
eCapture
eAll
EDataFlow_enum_count
End Enum

Private Type IMMDeviceEnumeratorVtbl
QueryInterface As Long
AddRef As Long
Release As Long
EnumAudioEndpoints As Long
GetDefaultAudioEndpoint As Long
GetDevice As Long
RegisterEndpointNotificationCallback As Long
UnregisterEndpointNotificationCallback As Long
End Type

Private Type IMMDeviceVtbl
QueryInterface As Long
AddRef As Long
Release As Long
Activate As Long
OpenPropertyStore As Long
GetId As Long
GetState As Long
End Type

Private Type IAudioEndpointVolumeVtbl
QueryInterface As Long
AddRef As Long
Release As Long
RegisterControlChangeNotify As Long
UnregisterControlChangeNotify As Long
GetChannelCount As Long
SetMasterVolumeLevel As Long
SetMasterVolumeLevelScalar As Long
GetMasterVolumeLevel As Long
GetMasterVolumeLevelScalar As Long
SetChannelVolumeLevel As Long
SetChannelVolumeLevelScalar As Long
GetChannelVolumeLevel As Long
GetChannelVolumeLevelScalar As Long
SetMute As Long
GetMute As Long
GetVolumeStepInfo As Long
VolumeStepUp As Long
VolumeStepDown As Long
QueryHardwareSupport As Long
GetVolumeRange As Long
End Type

Private Declare Sub RtlMoveMemory Lib "Kernel32.dll" (ByRef dest As Any, ByRef Source As Any, ByVal bytes As Long)
Private Declare Function IIDFromString Lib "Ole32.dll" (ByVal lpszIID As Long, ByRef iid As UUID) As Long
Private Declare Function CallWindowProcA Lib "User32.dll" (ByVal addr As Long, ByVal p1 As Long, ByVal p2 As Long, ByVal p3 As Long, ByVal p4 As Long) As Long
Private Declare Function CoCreateInstance Lib "Ole32.dll" (ByRef rclsid As UUID, ByVal pUnkOuter As Long, ByVal dwClsContext As Long, ByRef riid As UUID, ByRef ppv As Long) As Long

Private IAudioEndpointVolumeInterface As IAudioEndpointVolumeVtbl
Private m_pEndptVol As Long
Private IMMDeviceEnumeratorInterface As IMMDeviceEnumeratorVtbl
Private pEnumerator As Long
Private IMMDeviceInterface As IMMDeviceVtbl
Private pDevice As Long
Private pguidEventContext As UUID
Private hr As Long

Private Sub Class_Initialize()
Dim vtblAs Long
Dim MMDeviceEnumerator As UUID
Dim IMMDeviceEnumerator As UUID
Dim IAudioEndpointVolumeAs UUID
IIDFromString StrPtr(CLSID_MyContext), pguidEventContext
IIDFromString StrPtr(CLSID_MMDeviceEnumerator), MMDeviceEnumerator
IIDFromString StrPtr(IID_IMMDeviceEnumerator), IMMDeviceEnumerator
IIDFromString StrPtr(IID_IAudioEndpointVolume), IAudioEndpointVolume

hr = CoCreateInstance(MMDeviceEnumerator, 0, CLSCTX_INPROC_SERVER, IMMDeviceEnumerator, pEnumerator)

If hr <> 0 Then
Exit Sub
End If

RtlMoveMemory vtbl, ByVal pEnumerator, 4
RtlMoveMemory IMMDeviceEnumeratorInterface, ByVal vtbl, Len(IMMDeviceEnumeratorInterface)
hr = CallPointer(IMMDeviceEnumeratorInterface.GetDefaultAudioEndpoint, pEnumerator, eRender, eConsole, VarPtr(pDevice))

If hr <> 0 Then
Exit Sub
End If

RtlMoveMemory vtbl, ByVal pDevice, 4
RtlMoveMemory IMMDeviceInterface, ByVal vtbl, Len(IMMDeviceInterface)
hr = CallPointer(IMMDeviceInterface.Activate, pDevice, VarPtr(IAudioEndpointVolume), CLSCTX_ALL, 0, VarPtr(m_pEndptVol))

If hr <> 0 Then
Exit Sub
End If

RtlMoveMemory vtbl, ByVal m_pEndptVol, 4
RtlMoveMemory IAudioEndpointVolumeInterface, ByVal vtbl, Len(IAudioEndpointVolumeInterface)

End Sub

Private Sub Class_Terminate()
If pDevice <> 0 Then
hr = CallPointer(IMMDeviceInterface.Release, pDevice)
End If
If m_pEndptVol <> 0 Then
hr = CallPointer(IAudioEndpointVolumeInterface.Release, m_pEndptVol)
End If
End Sub

Public Function GetChannelCount() As Long
Dim pnChannelCount As Long
hr = CallPointer(IAudioEndpointVolumeInterface.GetChannelCount, m_pEndptVol, VarPtr(pnChannelCount))
GetChannelCount = pnChannelCount
End Function

Public Function GetChannelVolumeLevel(ByVal nChannel As Long) As Single
Dim pfLevelDB As Single
hr = CallPointer(IAudioEndpointVolumeInterface.GetChannelVolumeLevel, m_pEndptVol, nChannel, VarPtr(pfLevelDB))
GetChannelVolumeLevel = pfLevelDB
End Function

Public Function GetChannelVolumeLevelScalar(ByVal nChannel As Long) As Single
Dim pfLevel As Single
hr = CallPointer(IAudioEndpointVolumeInterface.GetChannelVolumeLevelScalar, m_pEndptVol, nChannel, VarPtr(pfLevel))
GetChannelVolumeLevelScalar = pfLevel
End Function

Public Function GetMasterVolumeLevel() As Single
Dim pfLevelDB As Single
hr = CallPointer(IAudioEndpointVolumeInterface.GetMasterVolumeLevel, m_pEndptVol, VarPtr(pfLevelDB))
GetMasterVolumeLevel = pfLevelDB
End Function

Public Function GetMasterVolumeLevelScalar() As Single
Dim pfLevel As Single
hr = CallPointer(IAudioEndpointVolumeInterface.GetMasterVolumeLevelScalar, m_pEndptVol, VarPtr(pfLevel))
GetMasterVolumeLevelScalar = pfLevel
End Function

Public Function GetMute() As Long
Dim pbMute As Long
hr = CallPointer(IAudioEndpointVolumeInterface.GetMute, m_pEndptVol, VarPtr(pbMute))
GetMute = pbMute
End Function

Public Sub GetVolumeRange(ByRef pfLevelMinDB As Single, ByRef pfLevelMaxDB As Single, ByRef pfVolumeIncrementDB As Single)
hr = CallPointer(IAudioEndpointVolumeInterface.GetVolumeRange, m_pEndptVol, VarPtr(pfLevelMinDB), VarPtr(pfLevelMaxDB), VarPtr(pfVolumeIncrementDB))
End Sub

Public Sub GetVolumeStepInfo(ByRef pnStep As Long, ByRef pnStepCount As Long)
hr = CallPointer(IAudioEndpointVolumeInterface.GetVolumeStepInfo, m_pEndptVol, VarPtr(pnStep), VarPtr(pnStepCount))
End Sub

Public Function QueryHardwareSupport() As Long
Dim pdwHardwareSupportMask As Long
hr = CallPointer(IAudioEndpointVolumeInterface.QueryHardwareSupport, m_pEndptVol, VarPtr(pdwHardwareSupportMask))
QueryHardwareSupport = pdwHardwareSupportMask
End Function

Public Sub RegisterControlChangeNotify(ByVal ptr As Long)
hr = CallPointer(IAudioEndpointVolumeInterface.RegisterControlChangeNotify, m_pEndptVol, ptr)
End Sub

Public Sub SetChannelVolumeLevel(ByVal nChannel As Long, ByVal fLevelDB As Single)
hr = CallPointer(IAudioEndpointVolumeInterface.SetChannelVolumeLevel, m_pEndptVol, nChannel, FloatToLongForCallee(fLevelDB), VarPtr(pguidEventContext))
End Sub

Public Sub SetChannelVolumeLevelScalar(ByVal nChannel As Long, ByVal fLevel As Single)
hr = CallPointer(IAudioEndpointVolumeInterface.SetChannelVolumeLevelScalar, m_pEndptVol, nChannel, FloatToLongForCallee(fLevel), VarPtr(pguidEventContext))
End Sub

Public Sub SetMasterVolumeLevel(ByVal fLevelDB As Single)
hr = CallPointer(IAudioEndpointVolumeInterface.SetMasterVolumeLevel, m_pEndptVol, FloatToLongForCallee(fLevelDB), VarPtr(pguidEventContext))
End Sub

Public Sub SetMasterVolumeLevelScalar(ByVal fLevel As Single)
hr = CallPointer(IAudioEndpointVolumeInterface.SetMasterVolumeLevelScalar, m_pEndptVol, FloatToLongForCallee(fLevel), VarPtr(pguidEventContext))
End Sub

Public Sub SetMute(ByVal bMute As Long)
hr = CallPointer(IAudioEndpointVolumeInterface.SetMute, m_pEndptVol, bMute, VarPtr(pguidEventContext))
End Sub

Public Sub UnregisterControlChangeNotify(ByVal ptr As Long)
hr = CallPointer(IAudioEndpointVolumeInterface.UnregisterControlChangeNotify, m_pEndptVol, ptr)
End Sub

Public Sub VolumeStepDown()
hr = CallPointer(IAudioEndpointVolumeInterface.VolumeStepDown, m_pEndptVol, VarPtr(pguidEventContext))
End Sub

Public Sub VolumeStepUp()
hr = CallPointer(IAudioEndpointVolumeInterface.VolumeStepUp, m_pEndptVol, VarPtr(pguidEventContext))
End Sub

Private Function FloatToLongForCallee(ByVal value As Single) As Long
Dim dwFloat As Long
RtlMoveMemory dwFloat, value, 4
FloatToLongForCallee = dwFloat
End Function


Private Function CallPointer(ByVal fnc As Long, ParamArray params()) As Long
Dim btASM(&HEC00& - 1) As Byte
Dim pASM As Long
Dim i As Integer

pASM = VarPtr(btASM(0))

AddByte pASM, &H58
AddByte pASM, &H59
AddByte pASM, &H59
AddByte pASM, &H59
AddByte pASM, &H59
AddByte pASM, &H50

For i = UBound(params) To 0 Step -1
AddPush pASM, CLng(params(i))
Next

AddCall pASM, fnc
AddByte pASM, &HC3

CallPointer = CallWindowProcA(VarPtr(btASM(0)), 0, 0, 0, 0)
End Function


Private Sub AddPush(pASM As Long, lng As Long)
AddByte pASM, &H68
AddLong pASM, lng
End Sub

Private Sub AddCall(pASM As Long, addr As Long)
AddByte pASM, &HE8
AddLong pASM, addr - pASM - 4
End Sub

Private Sub AddLong(pASM As Long, lng As Long)
RtlMoveMemory ByVal pASM, lng, 4
pASM = pASM + 4
End Sub

Private Sub AddByte(pASM As Long, bt As Byte)
RtlMoveMemory ByVal pASM, bt, 1
pASM = pASM + 1
End Sub

Üyeye Özelden Mesaj At scorpio3713 | 13.09.2011 23:09

Tüm Kategoriler | Visual Basic 6.0 | Visual Basic 6.0  1. Sayfa
© Hakan Ersöz 2000-2013| Üyelik Sözleşmesi | | Ödeme Bildirimi
Sitemizden yenilikleri hemen öğrenin, pop upları engelleyin, chat yapın... ToolBarımızı indirin:
Vasicmaster Toolbar'ı indirin