• ¡Welcome to Square Theme!
  • This news are in header template.
  • Please ignore this message.
مهمان عزیز خوش‌آمدید. ورود عضــویت


امتیاز موضوع:
  • 12 رای - 2.42 میانگین
  • 1
  • 2
  • 3
  • 4
  • 5
Title: کنترل صدا
حالت موضوعی
#1
سلام
یه کد میخوام که باهاش صدای خروجی سیستم رو کم و زیاد کنم همین
 
پاسخ
#2
کد:
Sub Form_Load ()
  Dim x As Integer
  Dim BothVolumes As Long

' Note that the waveid is 0 indicating the first wave output device.
' If you were to play multiple wavefiles on multiple wave output devices
' you would use 1 for the second wave output device, 2 for the third and
' so on.
' This code will retrieve the current volume setting

  x = waveOutGetVolume(0, BothVolumes)

  ' This code isolates the low-order word.
  ' Note that the value &HFFFF& is a Long Integer, which is the same
  ' as 0000FFFF, but because Visual Basic would automatically
  ' truncate this to FFFF, you must force the logical operation to use
  ' a four-byte Long Integer (0000FFFF) rather than a two-byte Integer
  ' (FFFF). This is accomplished by using the type casting
  ' character (&).
  CurrentVolLeft = BothVolumes And &HFFFF&

  ' This code isolates the high-order word.
  ' Enter the following two lines as one, single line:
  CurrentVolRight = ((BothVolumes And &HFFFF0000) / &H10000)
    And &HFFFF&

  LeftVol.Caption = Hex$(CurrentVolLeft)   ' Update the label with the
  RightVol.Caption = Hex$(CurrentVolRight) ' current volume settings.
End Sub

Sub PlaySound_Click ()
  Dim x As Integer
  Dim wFlags As Integer
  Dim SoundName As String
  SoundName = "C:\WINDOWS\MSREMIND.WAV"    ' Pick any wave file.
  wFlags = SND_ASYNC Or SND_NODEFAULT
  x = sndPlaySound(SoundName$, wFlags%)    ' Play the wave file.
End Sub

Sub LeftUp_Click ()
  ' Increase the left sound channel setting:
  Dim x As Integer
  CurrentVolLeft = CurrentVolLeft + &H1000&
  ' Prevent the channel setting from exceeding the maximum limit:
  If CurrentVolLeft > &HFFFF& Then CurrentVolLeft = &HFFFF&
  LeftVol.Caption = Format$(Hex$(CurrentVolLeft))
  ' Enter the following two lines as one, single line:
  x = waveoutSetVolume(0, CInt("&H" + Hex$(CurrentVolRight)),
     CInt("&H" + Hex$(CurrentVolLeft)))
End Sub

Sub LeftDown_Click ()
  ' Decrease the left sound channel setting:
  Dim x As Integer
  CurrentVolLeft = CurrentVolLeft - &H1000&
  ' Prevent the channel setting from dropping below the minimum limit:
  If CurrentVolLeft < &H0& Then CurrentVolLeft = &H0&
  LeftVol.Caption = Hex$(CurrentVolLeft)
  ' Enter the following two lines as one, single line:
  x = waveoutSetVolume(0, CInt("&H" + Hex$(CurrentVolRight)),
     CInt("&H" + Hex$(CurrentVolLeft)))
End Sub

Sub RightUp_Click ()
  ' Increase the right sound channel setting:
  Dim x As Integer
  CurrentVolRight = CurrentVolRight + &H1000&
  ' Prevent the channel setting from exceeding the maximum limit.
  If CurrentVolRight > &HFFFF& Then CurrentVolRight = &HFFFF&
  RightVol.Caption = Hex$(CurrentVolRight)
  ' Enter the following two lines as one, single line:
  x = waveoutSetVolume(0, CInt("&H" + Hex$(CurrentVolRight)),
     CInt("&H" + Hex$(CurrentVolLeft)))
End Sub

Sub RightDown_Click ()
  ' Decrease the right sound channel setting:
  Dim x As Integer
  CurrentVolRight = CurrentVolRight - &H1000&
  ' Prevent the channel setting from dropping below the minimum limit:
  If CurrentVolRight < 0 Then CurrentVolRight = 0
  RightVol.Caption = Hex$(CurrentVolRight)
  ' Enter the following two lines as one, single line:
  x = waveoutSetVolume(0, CInt("&H" + Hex$(CurrentVolRight)),
     CInt("&H" + Hex$(CurrentVolLeft)))
End Sub
گروه دور همی پارسی کدرز
https://t.me/joinchat/GxVRww3ykLynHFsdCvb7eg
 
پاسخ
#3
سلام
داداش ممنون از کدت اما موقعی که وارد پروژه کردم مشکل داره
نگاه به عکسها بنداز ببین میدونی چیه ؟



[عکس: Untitled.png]


[عکس: Untitled2.png]
 
پاسخ
#4
یه سری api داره تست کردم متاسفانه تو وین 8.1 جواب نمیده
این 2 تایپک رو ببین
http://www.devx.com/vb2themax/Tip/19040

http://www.ex-designz.net/apidetail.asp?api_id=530

ببین جوابتو میده ؟
گروه دور همی پارسی کدرز
https://t.me/joinchat/GxVRww3ykLynHFsdCvb7eg
 
پاسخ
#5
ممنوم دادا اما هیچ با هیچ کدوم نتونستم کار کنم
 
پاسخ
  


موضوعات مشابه ...
موضوع نویسنده پاسخ بازدید آخرین ارسال
  کامل ترین ریموت کنترل با قابلیت تبادل فایل ++ alakimalaki 0 3,349 07-29-2012، 12:26 PM
آخرین ارسال: alakimalaki
  مشکل در ادرس دهی بانک با کنترل adodc parvin 2 5,061 04-24-2012، 08:13 PM
آخرین ارسال: Amin_Mansouri
  ساخت کنترل به صورت پویا در vb6 Amin_Mansouri 0 3,134 10-11-2011، 11:44 AM
آخرین ارسال: Amin_Mansouri

پرش به انجمن:


Browsing: 1 مهمان