Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - .NET

Страница: 1 |

 

  Вопрос: Как считывать уровень звука через микрофон Добавлено: 02.09.10 15:30  

Автор вопроса:  Павел
Пожалуйста, подскажите код программы наблюдения за уровнем звука с микрофона. Желательно на VB-7. Ну что бы при превышении порога звука сработала какая-нибудь процедура.

Ответить

  Ответы Всего ответов: 1  

Номер ответа: 1
Автор ответа:
 Eugy



Вопросов: 0
Ответов: 73
  Профиль | | #1 Добавлено: 06.09.10 01:06
Разберешься?
  1. Imports System.Runtime.InteropServices
  2. Public Class Form1
  3.  
  4.     Private Const CALLBACK_FUNCTION = &H30000L
  5.     Private Const MM_WIM_DATA = &H3C0
  6.  
  7.     Private Structure WAVEFORMATEX
  8.         Dim wFormatTag As Int16
  9.         Dim nChannels As Int16
  10.         Dim nSamplesPerSec As Int32
  11.         Dim nAvgBytesPerSec As Int32
  12.         Dim nBlockAlign As Int16
  13.         Dim wBitsPerSample As Int16
  14.         Dim cbSize As Int16
  15.         Sub New(ByVal sample As Int32)
  16.             cbSize = Marshal.SizeOf(Me)
  17.             wFormatTag = 1 : nChannels = 1 : nBlockAlign = 1
  18.             wBitsPerSample = 8 : nSamplesPerSec = sample : nAvgBytesPerSec = sample
  19.         End Sub
  20.     End Structure
  21.  
  22.     Private Structure WAVEHDR
  23.         Dim lpData As IntPtr
  24.         Dim dwBufferLength As Int32
  25.         Dim dwBytesRecorded As Int32
  26.         Dim dwUser As IntPtr
  27.         Dim dwFlags As Int32
  28.         Dim dwLoops As Int32
  29.         Dim lpNext As IntPtr
  30.         Dim reserved As IntPtr
  31.         Sub New(ByVal sz As Int32)
  32.             lpData = Marshal.AllocHGlobal(sz)
  33.             dwBufferLength = sz
  34.         End Sub
  35.         Sub Free()
  36.             Marshal.FreeHGlobal(lpData)
  37.         End Sub
  38.     End Structure
  39.  
  40.     Private Structure MyTag
  41.         Dim hwav As IntPtr
  42.         Dim hhdr As IntPtr
  43.         Dim szhdr As Integer
  44.     End Structure
  45.  
  46.     Private MT As MyTag
  47.  
  48.     Private Delegate Sub ProgrValDeleg(ByVal peakvol As Byte)
  49.     Private Delegate Sub PtrwaveInProc(ByVal phwi As IntPtr, ByVal uMsg As Int32, ByVal dwInstance As Int32, ByVal dwParam1 As Int32, ByVal dwParam2 As Int32)
  50.  
  51.     Private Declare Function waveInOpen Lib "winmm" (ByRef phwi As IntPtr, ByVal uDeviceID As Int32, ByRef pwfx As WAVEFORMATEX, ByVal dwCallback As PtrwaveInProc, ByVal dwInstance As Int32, ByVal fdwOpen As Int32) As Int32
  52.     Private Declare Function waveInClose Lib "winmm" (ByVal phwi As IntPtr) As Int32
  53.     Private Declare Function waveInPrepareHeader Lib "winmm" (ByVal phwi As IntPtr, ByVal pwh As IntPtr, ByVal cbwh As Int32) As Int32
  54.     Private Declare Function waveInUnprepareHeader Lib "winmm" (ByVal phwi As IntPtr, ByVal pwh As IntPtr, ByVal cbwh As Int32) As Int32
  55.     Private Declare Function waveInAddBuffer Lib "winmm" (ByVal phwi As IntPtr, ByVal pwh As IntPtr, ByVal cbwh As Int32) As Int32
  56.     Private Declare Function waveInStart Lib "winmm" (ByVal phwi As IntPtr) As Int32
  57.     Private Declare Function waveInStop Lib "winmm" (ByVal phwi As IntPtr) As Int32
  58.  
  59.     Private Sub Form1_HandleCreated(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.HandleCreated
  60.         MicOpen()
  61.     End Sub
  62.  
  63.     Private Sub Form1_HandleDestroyed(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.HandleDestroyed
  64.         MicClose()
  65.     End Sub
  66.  
  67.     Private Sub MicOpen()
  68.         MT.szhdr = Marshal.SizeOf(New WAVEHDR)
  69.         MT.hhdr = Marshal.AllocHGlobal(MT.szhdr)
  70.         Marshal.StructureToPtr(New WAVEHDR(512), MT.hhdr, False)
  71.         waveInOpen(MT.hwav, -1, New WAVEFORMATEX(4096), AddressOf waveInProc, 0, CALLBACK_FUNCTION)
  72.         waveInPrepareHeader(MT.hwav, MT.hhdr, MT.szhdr)
  73.         waveInAddBuffer(MT.hwav, MT.hhdr, MT.szhdr)
  74.         waveInStart(MT.hwav)
  75.     End Sub
  76.  
  77.     Private Sub MicClose()
  78.         Dim whdr As WAVEHDR = Marshal.PtrToStructure(MT.hhdr, GetType(WAVEHDR))
  79.         waveInUnprepareHeader(MT.hwav, MT.hhdr, MT.szhdr)
  80.         waveInStop(MT.hwav)
  81.         waveInClose(MT.hwav)
  82.         whdr.Free()
  83.         Marshal.FreeHGlobal(MT.hhdr)
  84.     End Sub
  85.  
  86.     Private Sub waveInProc(ByVal hwi As IntPtr, ByVal uMsg As Int32, ByVal dwInstance As Int32, ByVal dwParam1 As Int32, ByVal dwParam2 As Int32)
  87.         If MM_WIM_DATA <> uMsg Then Return
  88.         Dim whdr As WAVEHDR = Marshal.PtrToStructure(New IntPtr(dwParam1), GetType(WAVEHDR))
  89.         Dim currvol As Integer, mastervol As Byte
  90.         For i As Int32 = 0 To whdr.dwBytesRecorded - 1
  91.             currvol = Math.Abs(Marshal.ReadByte(whdr.lpData, i)) - 127
  92.             If (currvol > mastervol) Then mastervol = currvol
  93.         Next
  94.         On Error Resume Next
  95.         Invoke(New ProgrValDeleg(AddressOf PeakMeterProc), New Object() {mastervol})
  96.         waveInAddBuffer(hwi, New IntPtr(dwParam1), Marshal.SizeOf(whdr))
  97.     End Sub
  98.  
  99.     Private Sub PeakMeterProc(ByVal peakvol As Byte)
  100.         Static prgrsbar As New ProgressBar
  101.         Controls.Add(prgrsbar)
  102.         prgrsbar.Minimum = 0
  103.         prgrsbar.Maximum = 16
  104.         If peakvol < 5 Then peakvol = 0
  105.         prgrsbar.Value = peakvol / 8
  106.     End Sub
  107.  
  108. End Class

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам