Захват звука со стерео микшера

[Alex-05]

Может кто нибудь знает,есть ли в Visual Basic 6 возможность захватывать звук со стерео микшера.Знаю что на Pure Basic такое возможно, там есть какая то библиотека bass.dll. Может её можно и в VB6 использовать?

[B.V.]

Цитата Alex-05 @ 22.02.13, 09:58

Может её можно и в VB6 использовать?

Можно. И конкурирующий FMOD можно. Примеры лежат в SDK библиотек (по крайней мере, в старых SDK они были)
А еще можно воспользоваться стандартными средствами DirectSound или wave-API

[TheTrik]

Для захвата с помощью DirectSound:

Private DX As New DirectX8
Private DSCap As DirectSoundCapture8
Private Buff As DirectSoundCaptureBuffer8
Private BuffDesc As DSCBUFFERDESC
Private EventsNotify() As DSBPOSITIONNOTIFY
Private EndEvent As Long, HalfEvent As Long
Private BuffLen As Long, HalfBuffLen As Long, HalfBufferLen As Long
Dim fNum As Integer
Implements DirectXEvent8
Public Function Initialize(Optional ByVal SamplesPerSec As Long = 44100, _
                            Optional ByVal BitsPerSample As Integer = 16, _
                            Optional ByVal Channels As Integer = 2) As Boolean
    Set DSCap = DX.DirectSoundCaptureCreate(vbNullString)
    With BuffDesc.fxFormat
        .nFormatTag = WAVE_FORMAT_PCM
        .nChannels = Channels
        .nBitsPerSample = BitsPerSample
        .lSamplesPerSec = SamplesPerSec
        .nBlockAlign = (.nBitsPerSample * .nChannels) \ 8
        .lAvgBytesPerSec = .lSamplesPerSec * .nBlockAlign
        HalfBuffLen = .lAvgBytesPerSec * 0.3
        HalfBuffLen = HalfBuffLen - (HalfBuffLen Mod .nBlockAlign)
    End With
    BuffLen = HalfBuffLen * 2
    BuffDesc.lBufferBytes = BuffLen
    BuffDesc.lFlags = DSCBCAPS_DEFAULT
    Set Buff = DSCap.CreateCaptureBuffer(BuffDesc)
    ReDim EventsNotify(1)
    HalfEvent = DX.CreateEvent(Me)
    EventsNotify(0).hEventNotify = HalfEvent
    EventsNotify(0).lOffset = BuffLen \ 2
    EndEvent = DX.CreateEvent(Me)
    EventsNotify(1).hEventNotify = EndEvent
    EventsNotify(1).lOffset = BuffLen - 2
    Buff.SetNotificationPositions 2, EventsNotify()
    Initialize = True
End Function
 
Private Sub cmdStart_Click()
    Buff.Start DSCBSTART_LOOPING
End Sub
Private Sub cmdStop_Click()
    Buff.Stop
    CloseFile
End Sub
Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long)
    Dim WaveBuffer() As Integer
    If Not (Buff Is Nothing) Then
        ReDim WaveBuffer(HalfBuffLen \ 2 - 1)
        Select Case eventid
        Case HalfEvent
            Buff.ReadBuffer 0, HalfBuffLen, WaveBuffer(0), DSCBLOCK_DEFAULT
        Case EndEvent
            Buff.ReadBuffer HalfBuffLen, HalfBuffLen, WaveBuffer(0), DSCBLOCK_DEFAULT
        End Select
    End If
    Put fNum, , WaveBuffer
End Sub
Private Sub WriteHeader()
    With BuffDesc.fxFormat
    Put fNum, , &H46464952 ' RIFF
    Put fNum, , 0&
    Put fNum, , &H45564157 'WAVE
    Put fNum, , &H20746D66 'fmt
    Put fNum, , 16&         'Size struct
    Put fNum, , CInt(WAVE_FORMAT_PCM)
    Put fNum, , .nChannels
    Put fNum, , .lSamplesPerSec
    Put fNum, , .lAvgBytesPerSec
    Put fNum, , .nBlockAlign
    Put fNum, , .nBitsPerSample
    Put fNum, , &H61746164 ' data
    Put fNum, , 0&
    End With
End Sub
Private Sub CloseFile()
    Dim fLen As Long
    fLen = LOF(fNum)
    Put fNum, 5, CLng(fLen - 8)
    Put fNum, 41, CLng(fLen - 44)
    Close fNum
End Sub
Private Sub Form_Load()
    Initialize
    fNum = FreeFile
    Open "D:\Temp.wav" For Binary As fNum
    WriteHeader
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Buff.Stop
    CloseFile
End Sub

В микшере, на запись выбери линейный вход. Если нужно программмно это делать, то через winmm можно, если найду код то выложу, где-то был.

Сообщение отредактировано: TheTrik - 22.02.13, 12:03

[Alex-05]

Цитата B.V. @ 22.02.13, 11:33

Можно. И конкурирующий FMOD можно. Примеры лежат в SDK библиотек (по крайней мере, в старых SDK они были)

А ткните пожалуйста пальцем где найти эти SDK библиотеки, что то не могу найти такой раздел.

[Alex-05]

Цитата Alex-05 @ 22.02.13, 16:39

В микшере, на запись выбери линейный вход.

Спасибо большое за пример. А подскажите пожалуйста в вашем примере, в каком месте этот перехваченный звук я могу загнать в какую нибудь переменную,чтобы потом можно было передавать эти данные через ком порт.Сам то я тут врятли разберусь.

[TheTrik]

Цитата Alex-05 @ 22.02.13, 16:58

А подскажите пожалуйста в вашем примере, в каком месте этот перехваченный звук я могу загнать в какую нибудь переменную,чтобы потом можно было передавать эти данные через ком порт.

Звук захватывается непрерывно и поэтому выборки звука переодически попадают в массив WaveBuffer в процедуре DirectXEvent8_DXCallback. Поэтому ты уже напрямую можешь брать из массива значения выборок. Если звук стерео, как в примере, то выборки чередуются Правая, Левая, Правая, Левая... Так что бери данные из массива и крути ими как хочешь.

[B.V.]

Цитата Alex-05 @ 22.02.13, 16:39

А ткните пожалуйста пальцем где найти эти SDK библиотеки, что то не могу найти такой раздел.

BASS: http://www.un4seen.com/bass.html
FMOD: http://www.fmod.org/fmod-downloads.html

Добавлено 22.02.13, 17:52
Кстати, проверил -- все VB6-примеры на месте

[Alex-05]

Цитата TheTrik @ 22.02.13, 17:26

Звук захватывается непрерывно и поэтому выборки звука переодически попадают в массив WaveBuffer в процедуре DirectXEvent8_DXCallback.

Не подскажешь из за чего может такая ошибка возникоть?

Прикреплённая картинка

[TheTrik]

В референсах подключил DirectX8 for Visual Basic Type library?

[Alex-05]

Цитата TheTrik @ 23.02.13, 11:02

В референсах подключил DirectX8 for Visual Basic Type library?

Спасибо!Всё работает.

[Alex-05]

Цитата B.V. @ 22.02.13, 17:46

Если звук стерео, как в примере, то выборки чередуются Правая, Левая, Правая, Левая...

Подскажи пожалуйста правильно ли я понимаю, WaveBuffer(1)-правая, WaveBuffer(2)-левая. Или WaveBuffer(1)-правая, WaveBuffer(2)-левая, WaveBuffer(3)-правая, WaveBuffer(4)-левая и т.д.Но тогда непонятно какая максимальная длинна этого масива. Ещё вопрос почему иногда приходят отрицательные значения? И ещё если не затруднит подскажи пожалуйста если знаешь как эти данные разложить на спектр частот. Ну скажем выделить низкие частоты или высокие?

[TheTrik]

Цитата

WaveBuffer(1)-правая, WaveBuffer(2)-левая, WaveBuffer(3)-правая, WaveBuffer(4)-левая

Да, только я ошибся, сначала идет левая потом правая выборка.

Цитата

Но тогда непонятно какая максимальная длинна этого масива

Длина массива всегда постоянна, равна длинне очередной порции данных =0.3 секунды, и задается (в байтах) в этой строчке

HalfBuffLen = .lAvgBytesPerSec * 0.3

Соответственно размер масиива = HalfBuffLen\2, т.к. нижняя граница = 0, поэтому HalfBuffLen\2-1

Цитата

Ещё вопрос почему иногда приходят отрицательные значения?

Потому что выборки в данном случае от -32768...32767.

Цитата

И ещё если не затруднит подскажи пожалуйста если знаешь как эти данные разложить на спектр частот

Можно использовать FFT (быстрое преобразование Фурье):
Просмотр спектра
Класс clsFFT:

Public Enum FFTType
    FT_DIRECT
    FT_INVERSE
End Enum
Dim Rcoef(13) As Single, Icoef(13) As Single
Public Function FFT(Rdat() As Single, Idat() As Single, N_ As Long, Ft_Flag As FFTType) As Boolean
    Dim LogN As Long, i As Long, j As Long, N As Long, K As Long, io As Long, ie As Long, in_ As Long, nn As Long
    Dim ru As Single, iu As Single, rtp As Single, itp As Single, rtq As Single, itq As Single, rw As Single, _
        iw As Single, sr As Single
    If N_ > 16384 Or N_ < 1 Then Exit Function
    If Not ((Not ((N_) And ((N_) - 1))) And ((N_) > 1)) Then Exit Function
    LogN = Log2(N_)
    If LogN < 2 Or LogN > 14 Then Exit Function
    If Ft_Flag <> FT_DIRECT And Ft_Flag <> FT_INVERSE Then Exit Function
    nn = N_ \ 2
    ie = N_
    For N = 1 To LogN
        rw = Rcoef(LogN - N)
        iw = Icoef(LogN - N)
        If Ft_Flag = FT_INVERSE Then iw = -iw
        in_ = ie \ 2: ru = 1: iu = 0
        For j = 0 To in_ - 1
            For i = j To N_ - 1 Step ie
                io = i + in_
                rtp = Rdat(i) + Rdat(io)
                itp = Idat(i) + Idat(io)
                rtq = Rdat(i) - Rdat(io)
                itq = Idat(i) - Idat(io)
                Rdat(io) = rtq * ru - itq * iu
                Idat(io) = itq * ru + rtq * iu
                Rdat(i) = rtp: Idat(i) = itp
            Next
            sr = ru
            ru = ru * rw - iu * iw
            iu = iu * rw + sr * iw
        Next
        ie = ie \ 2
    Next
    j = 1
    For i = 1 To N_ - 1
        If i < j Then
            io = i - 1: in_ = j - 1
            rtp = Rdat(in_): itp = Idat(in_)
            Rdat(in_) = Rdat(io)
            Idat(in_) = Idat(io)
            Rdat(io) = rtp
            Idat(io) = itp
        End If
        K = nn
        Do While K < j
            j = j - K
            K = K \ 2
        Loop
        j = j + K
    Next
    If Ft_Flag = FT_INVERSE Then FFT = True: Exit Function
    rw = 1 / N_
    For i = 0 To N_ - 1
        Rdat(i) = Rdat(i) * rw
        Idat(i) = Idat(i) * rw
    Next
    FFT = True
End Function
Private Function Log2(ByVal Value As Long) As Long
    Dim N As Long, R As Long, O As Long
    If Value <= 0 Then Log2 = -1: Exit Function
    R = Value
    Do Until R <= 1
        N = N + 1
        O = R Mod 2
        If O > 0 Then Log2 = -1: Exit Function
        R = R \ 2
    Loop
    Log2 = N
End Function
Private Sub Class_Initialize()
    Dim N As Long, vRcoef As Variant, vIcoef As Variant
    vRcoef = Array(-1#, 0#, 0.707106781186547 _
          , 0.923879532511287, 0.98078528040323, 0.995184726672197 _
          , 0.998795456205172, 0.999698818696204, 0.999924701839145 _
          , 0.999981175282601, 0.999995293809576, 0.999998823451702 _
          , 0.999999705862882, 0.999999926465718)
    vIcoef = Array(0#, -1#, -0.707106781186547 _
         , -0.38268343236509, -0.195090322016128, -9.80171403295606E-02 _
         , -0.049067674327418, -2.45412285229122E-02, -1.22715382857199E-02 _
         , -6.1358846491544E-03, -3.0679567629659E-03, -1.5339801862847E-03 _
         , -7.669903187427E-04, -3.834951875714E-04)
    For N = 0 To 13
        Rcoef(N) = vRcoef(N)
        Icoef(N) = vIcoef(N)
    Next
End Sub

Цитата

Ну скажем выделить низкие частоты или высокие?

Можно использовать фильтр (БИХ, КИХ):

Const SamplePerSec=44000 '44KHz
 Const pi=3.14159265358979
 
 Private Sub LowPass(Data() as Integer) ' Для 16-бит моно
     Dim R as Single, F as Single, a1 as Single, a2 as Single, a3 as Single
     Dim b1 as Single, b2 as Single, n as Long, Temp() as Integer
     Dim c as Single
     ' R-Резонанс sqr(2)...0.1
     ' F-Частота обрезки 0...SamplePerSec/2
     Redim Temp(Ubound(Data))
     Temp=Data
     ' Расчет БИХ-фильтра
     c = 1.0 / Tan(pi * F / SamplePerSec)
     a1 = 1.0 / ( 1.0 + R * c + c * c)
     a2 = 2* a1
     a3 = a1
     b1 = 2.0 * ( 1.0 - c*c) * a1
     b2 = ( 1.0 - R * c + c * c) * a1
     For n=2 to Ubound(Data)
         Data(n) = a1 * Temp+ a2 * Temp(n-1) + a3 * Temp(n-2) - b1*Data(n-1) - b2*Data(n-2)
     Next n
 End Sub
 
 Private Sub HighPass(Data() as Integer) ' Для 16-бит моно
     Dim R as Single, F as Single, a1 as Single, a2 as Single, a3 as Single
     Dim b1 as Single, b2 as Single, n as Long, Temp() as Integer
     Dim c as Single
     ' R-Резонанс sqr(2)...0.1
     ' F-Частота обрезки 0...SamplePerSec/2
     Redim Temp(Ubound(Data))
     Temp=Data
     ' Расчет БИХ-фильтра
     c = Tan(pi * F / SamplePerSec)
     a1 = 1.0 / ( 1.0 + r * c + c * c)
     a2 = -2*a1
     a3 = a1
     b1 = 2.0 * ( c*c - 1.0) * a1
     b2 = ( 1.0 - R * c + c * c) * a1
     For n=2 to Ubound(Data)
         Data(n) = a1 * Temp+ a2 * Temp(n-1) + a3 * Temp(n-2) - b1*Data(n-1) - b2*Data(n-2)
     Next n
 End Sub

Сообщение отредактировано: TheTrik - 23.02.13, 20:53

[Alex-05]

TheTrik спасибо огромнейшее.Буду разбираться.