Вокодер на VB6 часть 2

Автор обещает много интересных штучек.

Модератор: The trick

The trick
Постоялец
Постоялец
 
Сообщения: 774
Зарегистрирован: 26.06.2010 (Сб) 23:08

Вокодер на VB6 часть 2

Сообщение The trick » 01.12.2014 (Пн) 19:35

Первая часть.
Итак, исходный сигнал и модулирующий мы имеем. Теперь следующим этапом является фильтрация. Можно пойти несколькими путями: использовать банк фильтров (БИХ, КИХ), либо использовать БПФ (FFT, быстрое преобразование Фурье) или Вейвлет-преобразование. Для своей задачи возьмем оконное БПФ, т.к. расчет БИХ фильтров довольно сложная задача, а КИХ фильтры по вычислительной сложности не очень эффективны. (Честно говоря, изначально я сделал реализацию на БИХ фильтрах Баттерворта 2-го порядка, но меня не устраивало качество и нагрузка на процессор). С БПФ получается все довольно просто. Раскладываем речевой сигнал на гармоники где каждый элемент вектора представляет информацию об определенной частоте (получается что-то вроде большого количества полосовых фильтров). Также раскладываем несущий сигнал и выполняем модуляцию. После всего делаем обратное преобразование и получаем нужный сигнал. Получается что БПФ делает сразу 2 задачи - это раскладывает сигнал на полосы частот (см. схему) и выполняет микширование сигнала после ОБПФ. Для нашей задачи сделаем регулировку количества частотных полос, это позволит настроить нужную окраску тембра. Для БПФ и его обвязки напишем класс clsTrickFFT:
Код: Выделить всё
' clsTrickFFT  - класс для быстрого преобразования Фурье
' © Кривоус Анатолий Анатольевич (The trick), 2014

Option Explicit

Public Enum WindowType
    WT_RECTANGLE
    WT_TRIGANULAR
    WT_HAMMING
    WT_HANN
End Enum

Private Coef(1, 13) As Single
Private mFFTSize    As Long
Private mLog        As Long
Private mWindow()   As Single
Private mType       As WindowType

' // Тип окна
Public Property Get WindowType() As WindowType
    WindowType = mType
End Property
Public Property Let WindowType(ByVal Value As WindowType)

    If InitWindow(Value) Then
   
        mType = Value
       
    End If
   
End Property

' // Задает размер FFT
Public Property Let FFTSize(ByVal Value As Long)
    Dim log2    As Double
   
    log2 = Log(Value) / Log(2)
    ' Число должно быть степенью 2-ки
    If log2 <> Fix(log2) Then
        err.Raise 5
        Exit Property
    End If
    ' Проверяем выход за пределы
    If log2 < 2 Or log2 > 16384 Then
        err.Raise 9
        Exit Property
    End If
   
    InitWindow mType
   
    mLog = log2
    mFFTSize = Value
   
End Property

' // Применить оконную функцию
Public Function ApplyWindow(data() As Single) As Boolean
    Dim index   As Long
    Dim count   As Long
   
    count = UBound(data, 2) + 1

    For index = 0 To count - 1
        data(0, index) = data(0, index) * mWindow(index)
    Next
   
    ApplyWindow = True
   
End Function

' // Конвертировать 16-битные отсчеты в нормализованные комплексные значения
Public Function Convert16BitToComplex(inData() As Integer, outData() As Single) As Boolean
    Dim index   As Long

    For index = 0 To UBound(inData)
        outData(0, index) = inData(index) / 32768
        outData(1, index) = 0
    Next
   
    Convert16BitToComplex = True
   
End Function

' // Конвертировать комплексные отсчеты, представляющие реальный сигнал в 16-битные реальные
Public Function ConvertComplexTo16Bit(inData() As Single, outData() As Integer) As Boolean
    Dim index   As Long
    Dim Value   As Long
   
    For index = 0 To UBound(inData, 2)
        Value = inData(0, index) * 32767
        If Value > 32767 Then Value = 32767 Else If Value < -32768 Then Value = -32768
        outData(index) = Value
    Next
   
    ConvertComplexTo16Bit = True
       
End Function

' // Выполняет зеркалирование
Public Function MakeMirror(data() As Single) As Boolean
    Dim index   As Long
    Dim pointer As Long
   
    pointer = mFFTSize - 1
   
    For index = 1 To mFFTSize \ 2 - 1
        data(0, pointer) = data(0, index)
        data(1, pointer) = -data(1, index)
        pointer = pointer - 1
    Next
   
    MakeMirror = True
   
End Function

' // Быстрое преобразование Фурье
Public Function FFT(data() As Single, ByVal IsInverse As Boolean) As Boolean
    Dim 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 ur As Single, ui As Single, tpr As Single, tpi As Single, tqr As Single, tqi As Single, _
        wr As Single, wi As Single, sr As Single, ti As Long, tr As Long
   
    nn = mFFTSize \ 2: ie = mFFTSize
    For n = 1 To mLog
        wr = Coef(0, mLog - n): wi = Coef(1, mLog - n)
        If IsInverse Then wi = -wi
        in_ = ie \ 2: ur = 1: ui = 0
        For j = 0 To in_ - 1
            For i = j To mFFTSize - 1 Step ie
                io = i + in_
                tpr = data(0, i) + data(0, io): tpi = data(1, i) + data(1, io)
                tqr = data(0, i) - data(0, io): tqi = data(1, i) - data(1, io)
                data(0, io) = tqr * ur - tqi * ui: data(1, io) = tqi * ur + tqr * ui
                data(0, i) = tpr: data(1, i) = tpi
            Next
            sr = ur: ur = ur * wr - ui * wi: ui = ui * wr + sr * wi
        Next
        ie = ie \ 2
    Next
    ' Перестановка
    j = 1
    For i = 1 To mFFTSize - 1
        If i < j Then
            io = i - 1: in_ = j - 1: tpr = data(0, in_): tpi = data(1, in_)
            data(0, in_) = data(0, io): data(1, in_) = data(1, io)
            data(0, io) = tpr: data(1, io) = tpi
        End If
        K = nn
        Do While K < j
            j = j - K: K = K \ 2
        Loop
        j = j + K
    Next
    If IsInverse Then FFT = True: Exit Function
    ' Нормализация
    wr = 1 / mFFTSize
    For i = 0 To mFFTSize - 1
        data(0, i) = data(0, i) * wr: data(1, i) = data(1, i) * wr
    Next
    FFT = True
   
End Function

' // Инициализация окна
Public Function InitWindow(ByVal Window As WindowType) As Boolean
    Dim index   As Long
   
    Select Case Window
    Case WT_RECTANGLE
        ReDim mWindow(mFFTSize - 1)
        For index = 0 To mFFTSize - 1
            mWindow(index) = 1
        Next
    Case WT_TRIGANULAR
        ReDim mWindow(mFFTSize - 1)
        For index = 0 To mFFTSize - 1
            mWindow(index) = IIf(index < mFFTSize \ 2, index / mFFTSize * 2, 1 - index / (mFFTSize - 1))
        Next
    Case WT_HAMMING
        ReDim mWindow(mFFTSize - 1)
        For index = 0 To mFFTSize - 1
            mWindow(index) = 0.53836 - 0.46164 * Cos(6.28318530717959 * index / (mFFTSize - 1))
        Next
    Case WT_HANN
        ReDim mWindow(mFFTSize - 1)
        For index = 0 To mFFTSize - 1
            mWindow(index) = 0.5 * (1 - Cos(6.28318530717959 * index / (mFFTSize - 1)))
        Next
    Case Else
        err.Raise 5
        Exit Function
    End Select

    InitWindow = True
   
End Function

' // Инициализация поворотных множителей для FFT и размера по умолчанию
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
        Coef(0, n) = vRcoef(n): Coef(1, n) = vIcoef(n)
    Next
   
    mFFTSize = 512
    mLog = 9
    mType = WT_HAMMING
    InitWindow mType
   
End Sub

Само преобразование выполняет метод FFT; для обратного преобразования вторым параметром передается True. В качестве комплексных чисел будем использовать массив вида arr(1, x), где x - количество комплексных, чисел arr(0, x) - реальная часть, arr(1, x) - мнимая часть. Подробно останавливаться на ПФ я не буду, т.к. это очень большая тема, и кому интересно в сети есть много статей где доступным языком объясняется его смысл и свойства; рассмотрим только основные моменты. Для преобразования нужно исходный действительный сигнал загнать в массив комплексных чисел, обнуляя мнимую часть (по правде говоря исходя из свойств ПФ можно еще ускорить если записать в реальную часть одну часть а в мнимую другую, но я не стал так усложнять). После преобразования получим набор комплексных коэффициентов где реальной части соответствуют коэффициенты перед косинусом, а в мнимой перед синусом. Если представить это на комплексной плоскости, то каждый коэффициент представляет собой вектор, длина которого характеризует амплитуду сигнала на этой частоте, а угол - фазу:
Изображение
Также имеет место зеркальный эффект (муар)- зеркальное отображение коэффициентов относительно половины частоты дискретизации, который равен по амплитуде и противоположен по фазе. Это происходит из-за дискретизации сигнала, т.к. частоты могут корректно представлены только до половины частоты дискретизации при увеличении частоты происходит алиасинг:
Изображение
Как видно красная синусоида изначально имеет частоту равную 2 периодам дискретизации, и постепенно период дискретизации увеличивается, частота дискретизированного сигнала уменьшается и в итоге при частоте дискретизации равной частоте синусоиды частота сигнала становится равной 0 герц. Из-за этого коэффициенты Фурье зеркально отображены относительно половины частоты дискретизации. Поэтому при работе со спектром можно обрабатывать только половину спектра, перед ОБПФ нужно просто зеркально скопировать вторую половину массива только сделать комплексное сопряжение (дополнительно мнимые коэффициенты умножить на -1). Для этого предусмотрен метод MakeMirror. При модуляции сигнала у нас будут возникать фазовые искажения, т.к. делая преобразование на каком либо участке сигнала, мы принимаем этот участок за 1 период, который повторяется по обе стороны окна бесконечно долго. И если мы вносим какие-либо изменения в спектр, то наши сигналы могут не совпадать на краях окна и будут возникать разрывы (в нашем случае щелчки). Для предотвращения этого мы умножим сигнал на весовое окно, которое плавно к краям уменьшает амплитуду сигнала, а сами блоки возьмем с перекрытием. Т.к. нам не нужно высокое качество звука, то мы не будем использовать весовые окна до преобразования (хотя следовало бы так сделать, т.к. имеет место размазывание частот), а вычислим в "лоб" с сырым сигналом, преобразуем, выполним ОБПФ и только для результата применим оконную функцию. Также это позволит брать блоки с перекрытием в 50% что на слух приемлемо и достаточно быстро. Чтобы было понятно вот наглядно пример:
Изображение
Как видно мы берем исходный сигнал 2 раза со сдвигом, захватывая вторую половину во втором проходе. После манипуляций мы микшируем эти два сигнала в месте перекрытия и выдаем на выход первую часть, половина второй части будет позже микшироваться со следующими частями. В качестве окна мы будем использовать окно Ханна. Сам метод называется ApplyWindow. Исходник класса прокомментирован, поэтому я не буду подробно останавливаться на нем.
Как было сказано выше для работы FFT нам нужно брать данные с перекрытием и отправлять данные на выход с перекрытием. Для этого мы напишем специальный класс (clsTrickOverlappedBuffer), который будет выдавать нам данные с учетом перекрытия:
Код: Выделить всё
' clsTrickOverlappedBuffer  - класс перекрывающегося буфера
' © Кривоус Анатолий Анатольевич (The trick), 2014

Option Explicit

Private iBuffer()   As Single       ' Буфер входных значений
Private oBuffer()   As Single       ' Буфер выходных значений
Private mInit       As Boolean      ' Инициализирован ли объект
Private miWritePtr  As Long         ' Индекс текущей позиции записи во входном буфере
Private moWritePtr  As Long         ' Индекс текущей позиции записи в выходном буфере
Private mWndSize    As Long         ' Размер порции данных для ввода/вывода
Private mOverlap    As Long         ' Размер перекрывания в семплах
Private iPtr        As Long         ' Текущая позиция чтения во входном буфере
Private oPtr        As Long         ' Текущая позиция чтения в выходном буфере
Private sampleSize  As Long         ' Размер выборки в байтах

' // Инициализация
Public Function Init(ByVal windowSize As Long, ByVal overlapSizeSamples As Long) As Boolean

    If overlapSizeSamples > windowSize Or overlapSizeSamples <= 0 Then Exit Function
    If windowSize <= 0 Then Exit Function
   
    ' Выделяем буфер в 2 раза большего размера для минимального перекрытия windowSize
    ReDim iBuffer(1, windowSize * 2 - 1)
    ReDim oBuffer(1, windowSize * 2 - 1)
   
    mInit = True
    mWndSize = windowSize
    mOverlap = overlapSizeSamples
    miWritePtr = mWndSize
   
    Init = True

End Function

' // Записать фрейм во входной буфер
Public Function WriteInputData(data() As Single) As Boolean

    memcpy iBuffer(0, miWritePtr), data(0, 0), (UBound(data, 2) + 1) * sampleSize
    miWritePtr = IIf(miWritePtr, 0, mWndSize)
    WriteInputData = True
   
End Function

' // Записать фрейм в выходной буфер
Public Function WriteOutputData(data() As Single) As Boolean
    Dim sampleCount As Long
    Dim inSample    As Long
    Dim pointer     As Long
    Dim rest        As Long
   
    pointer = moWritePtr
    ' Сначала микшируем перекрывающиеся данные
    ' Проверяем количество семплов до конца буфера
    sampleCount = mWndSize * 2 - pointer
    ' Если недостаточно семплов до конца буфера, то копируем до конца
    If sampleCount > mOverlap Then sampleCount = mOverlap
    ' Микшируем
    For inSample = 0 To sampleCount - 1
   
        oBuffer(0, pointer) = oBuffer(0, pointer) + data(0, inSample)
        pointer = pointer + 1
       
    Next
    ' Если не все скопировали, то продолжаем сначала
    If sampleCount < mOverlap Then
   
        pointer = 0
       
        Do While pointer < mOverlap - sampleCount
       
            oBuffer(0, pointer) = oBuffer(0, pointer) + data(0, inSample)
            pointer = pointer + 1
            inSample = inSample + 1
           
        Loop
       
    End If
   
    moWritePtr = pointer
   
    ' Теперь копируем неперекрывающуюся часть
    sampleCount = mWndSize * 2 - pointer
    rest = mWndSize - mOverlap
    ' Корректируем с учетом выхода за пределы
    If sampleCount > rest Then sampleCount = rest
    ' Копируем
    If sampleCount Then memcpy oBuffer(0, pointer), data(0, inSample), sampleCount * sampleSize
    ' Если был перенос, то копируем в начало
    If sampleCount < rest Then
   
        pointer = 0
        memcpy oBuffer(0, pointer), data(0, inSample), (rest - sampleCount) * sampleSize
       
    End If
   
    WriteOutputData = True
   
End Function

' // Получить данные входного буфера
Public Function GetInputBuffer(data() As Single) As Boolean
    Dim sampleCount As Long
    ' Получаем доступное количество семплов до конца буфера
    sampleCount = mWndSize * 2 - iPtr
    ' Корректируем
    If sampleCount > mWndSize Then sampleCount = mWndSize
    ' Копируем
    If sampleCount > 0 Then
        memcpy data(0, 0), iBuffer(0, iPtr), sampleCount * sampleSize
    End If
    ' При необходимости копируем с начала буфера
    If sampleCount < mWndSize Then
        memcpy data(0, sampleCount), iBuffer(0, 0), (mWndSize - sampleCount) * sampleSize
    End If
    ' Обновляем позицию
    iPtr = (iPtr + mOverlap) Mod mWndSize * 2

    GetInputBuffer = True

End Function

' // Получить данные выходного буфера
Public Function GetOutputBuffer(data() As Single) As Boolean
    Dim sampleCount As Long
    ' Получаем доступное количество семплов до конца буфера
    sampleCount = mWndSize * 2 - oPtr
    ' Корректируем
    If sampleCount > mWndSize Then sampleCount = mWndSize
    ' Копируем
    If sampleCount > 0 Then
        memcpy data(0, 0), oBuffer(0, oPtr), sampleCount * sampleSize
        oPtr = oPtr + sampleCount
    End If
    ' При необходимости копируем с начала буфера
    If sampleCount < mWndSize Then
        memcpy data(0, sampleCount), oBuffer(0, 0), (mWndSize - sampleCount) * sampleSize
        oPtr = mWndSize - sampleCount
    End If

    GetOutputBuffer = True

End Function

Private Sub Class_Initialize()
    sampleSize = 8
End Sub

Метод Init инициализирует внутренние буферы хранения данных. Метод WriteInputData записывает во внутренний буфер данные входного сигнала. С помощью этого метода мы будем записывать захваченный сигнал и несущий сигнал. Метод WriteOutputData микширует переданные данные во внутреннем буфере с прошлыми данными добавленными в предыдущем вызове этого метода. Этот метод мы будем использовать для обработанных данных и писать уже промодулированный сигнал с помощью этого метода. GetInputBuffer и GetOutputBuffer заполняют входной буфер данными с учетом перекрытия. GetInputBuffer получает данные записанные методом WriteInputData, соответственно метод GetOutputBuffer получает данные записанные методом WriteOutputData.
Теперь рассмотрим сам модулятор представленный классом clsTrickModulator, который занимается непосредственно преобразованием спектра:
Код: Выделить всё
' clsTrickModulator  - класс модулятора
' © Кривоус Анатолий Анатольевич (The trick), 2014

Option Explicit

Private mBands      As Long     ' Количество полос
Private mDryWet     As Single   ' Баланс исходного и обработанного звука
Private mVolume     As Single   ' Громкость
Private mLevels()   As Single   ' АЧХ

' // Громкость
Public Property Let Volume(ByVal Value As Single)
    mVolume = Value
End Property
Public Property Get Volume() As Single
    Volume = mVolume
End Property

' // АЧХ
Public Function SetLevels(Value() As Single) As Boolean
    mLevels = Value
End Function
Public Property Get Levels(ByVal index As Long) As Single
    Levels = mLevels(index)
End Property

' // Баланс
Public Property Let DryWet(ByVal Value As Single)
    If Abs(Value) > 1 Then
        err.Raise 9
        Exit Property
    End If
    mDryWet = Value
End Property
Public Property Get DryWet() As Single
    DryWet = mDryWet
End Property

' // Количество полос
Public Property Let Bands(ByVal Value As Long)
    If Value > 128 Or Value <= 0 Then
        err.Raise 9
        Exit Property
    End If
    mBands = Value
End Property
Public Property Get Bands() As Long
    Bands = mBands
End Property

' // Функция выполняет обработку
Public Function Process(carrier() As Single, modulation() As Single) As Boolean
    Dim nCount          As Long
    Dim band            As Long
    Dim endBand         As Long
    Dim sample          As Long
    Dim samplePerBand   As Long
    Dim offsetSample    As Long
    Dim modValue        As Single
    Dim ampValue        As Single
    Dim invDryWet       As Single
    Dim FFTSize         As Long
   
    invDryWet = 1 - mDryWet
    FFTSize = (UBound(carrier, 2) + 1)
    ' Зеркальную сторону не вычисляем
    nCount = FFTSize \ 2
    ' Получаем число отсчетов на полосу
    samplePerBand = nCount \ mBands
    ' Вычисляем величину усиления
    ampValue = (Sqr(mBands) * invDryWet) / 2.5 + mDryWet
    ' Проходим по полосам
    For band = 0 To mBands - 1
        ' Проверяем выход за пределы
        endBand = band * samplePerBand + samplePerBand
        If endBand >= nCount Then endBand = nCount - 1
        ' Обнуляем величину спектральной составляющей для текущей полосы
        modValue = 0
        ' Проходим по отсчетам спектра текущей полосы
        For sample = band * samplePerBand To endBand
            ' Вычисляем величину спекта для всех отсчетов полосы
            modValue = modValue + Sqr(modulation(0, sample) * modulation(0, sample) + _
                                      modulation(1, sample) * modulation(1, sample))
        Next
        ' Модулируем в текущей полосе
        For sample = band * samplePerBand To endBand
            carrier(0, sample) = ((carrier(0, sample) * modValue * invDryWet) + _
                                 (modulation(0, sample) * mDryWet)) * ampValue * mLevels(sample) * mVolume
            carrier(1, sample) = ((carrier(1, sample) * modValue * invDryWet) + _
                                 (modulation(1, sample) * mDryWet)) * ampValue * mLevels(sample) * mVolume
        Next
    Next
   
End Function

Private Sub Class_Initialize()
    mDryWet = 0
    mVolume = 1
End Sub

Класс имеет свойство Volume, которое определяет уровень выходной громкости. Свойство Bands определяет количество полос на которые будет делится спектр при модуляции. К примеру при частоте дискретизации 44100 Гц. и размере БПФ равным 2048, получим разрешение по частоте равное 44100 / 2048 ≈ 21.53 Гц. При количестве частотных полос равной 64 будем брать по 2048 / 2 / 64 = 16 отсчетов (344.48 Гц) частоты, для каждой модуляции. Свойство DryWet определяет баланс между оригинальным сигналом и преобразованным на выходе модулятора. Метод SetLevels задает массив с коэффициентами амплитудно-частотной характеристики (АЧХ) на которую умножается сигнал. Это позволит производить эквализацию сигнала и улучшить качество звука после обработки. Самый главный метод - Process, который собственно и производит обработку; разберем его подробней. Сначала мы вычисляем количество отсчетов на одну полосу исходя из свойства Bands, потом вычисляем коэффициент усиления выходного сигнала в зависимости от количества частотных полос - эта формула получена экспериментально. Дальше мы проходим по частотным полосам речевого (modulation) сигнала и в коэффициентах соответствующих каждой полосе вычисляем энергию данных частот. Ранее я писал что амплитуда спектральной составляющей - это длина вектора, поэтому мы просто суммируем длины векторов соответствующих частот, это и будет энергия в данном диапазоне частот. Далее мы проходим уже по несущему сигналу в тех же спектральных отсчетах изменяем уровень сигнала в соответствии с вычисленной энергией, также сразу вычисляем выходной уровень, применяем эквализацию. При умножении двух компонент вектора (комплексного числа) на величину энергии происходит его масштабирование. Всеми этими манипуляциями мы модулируем несущий сигнал, речевым, что нам и требовалось.
Итак, все компоненты готовы. Теперь нужно все собрать и проверять работу. Для пользовательского интерфейса я разработал несколько контролов специально для вокодера. Описывать принцип работы и разработку каждого я не буду, т.к. это займет много времени, а расскажу вкратце о каждом из них. ctlTrickKnob - контрол регулятор, что-то вроде обычного потенциометра. С ним все понятно это обычный регулятор, подобие того же виндового Slider'а, только с круговой регулировкой. ctlTrickCommand - это обычная кнопка с поддержкой иконки и добавлена только для внешнего вида. ctlTrickEqualizer - самый интересный контрол. Он позволяет корректировать АЧХ сигнала. Его панель имеет логарифмическую шкалу, как по частотам, так и по уровням, что позволяет более естественно для слуха изменять параметры. Для добавления точки на АЧХ нужно нажать левой кнопкой в пустом месте, для удаления - правой. При изменении АЧХ контрол генерирует событие Change. Все контролы предназначены только для вокодера, поэтому их функционал минимален.
Теперь все "закидываем" на форму, и пишем код:
Код: Выделить всё
' frmTrickVocoder  - главная форма TrickVocoder
' © Кривоус Анатолий Анатольевич (The trick), 2014

Option Explicit

Dim WithEvents AudioCapture     As clsTrickSound    ' Объект захвата звука
Dim WithEvents AudioPlayback    As clsTrickSound    ' Объект записи звука

Private inpBuffer() As Integer                      ' Буфер захвата звука
Private outBuffer() As Integer                      ' Буфер воспроизведения звука
Private rawBuffer() As Integer                      ' Буфер сырых данных исходного Wave-файла
Private plyBuffer   As clsTrickOverlappedBuffer     ' Буфер перекрывающихся данных несущей
Private capBuffer   As clsTrickOverlappedBuffer     ' Буфер перекрывающихся данных модулятора
Private FFT         As clsTrickFFT                  ' Объект для работы с FFT и преобразованием буфера звука
Private Modulator   As clsTrickModulator            ' Модулятор
Private mFFTSize    As Long                         ' Размер FFT
Private mOverlap    As Long                         ' Количество перекрытий
Private mRawSize    As Long                         ' Размер сырых данных буфера в семплах
Private mInpFile    As String                       ' Имя файла, если захват из файла
Private tmpCapBuf() As Single                       ' Временный буфер захвата
Private tmpPlyBuf() As Single                       ' Временный буфер воспроизведения
Private wavConv     As clsTrickWavConverter         ' Объект-конвертер сигнала носителя
Private inpConv     As clsTrickWavConverter         ' Объект-конвертер модулирующего сигнала

' // Получить объект захвата
Public Property Get AudioCaptureDevice() As clsTrickSound
    Set AudioCaptureDevice = AudioCapture
End Property

' // Получить имя файла захвата
Public Property Get InputFileName() As String
    InputFileName = mInpFile
End Property

' // Закрыть окно
Private Sub btnClose_Click()
    Unload Me
End Sub

' // Открыть файл несущего сигнала
Private Sub btnOpenCarrier_Click()
    Dim FileName    As String
    Dim conv        As clsTrickWavConverter
    ' Получаем имя файла
    FileName = GetFile(Me.hwnd)
   
    If Len(FileName) Then

        Set conv = New clsTrickWavConverter
        ' При успешном чтении устанавливаем его в качестве текущего
        If conv.ReadWaveFile(FileName) Then
            Set wavConv = conv
        End If
       
    End If
   
End Sub

' // Настройки
Private Sub btnSettings_Click()
    Dim frm As frmSettings
    Dim cur As Long
   
    Set frm = New frmSettings
   
    frm.Show vbModal
    ' При нажатии ОК
    If frm.Result = vbOK Then
        ' Получаем текущее устройство захвата
        cur = AudioCapture.CurrentCaptureDeviceID()
        ' Очищаем буфер, т.к. если дальше будет неудача то мы будем слышать зацикленный текущий сигнал
        memset inpBuffer(0), mFFTSize * 2, 0
       
        If frm.SelectedDevice >= AudioCapture.CaptureDevices.count Then
            ' Захват из файла
            Set inpConv = Nothing
            Set inpConv = New clsTrickWavConverter
            ' Читаем файл
            If Not inpConv.ReadWaveFile(frm.FileName) Then
                ' Восстанавливаем назад
                InitCapture cur
               
            Else
           
                mInpFile = frm.FileName
                AudioCapture.StopProcess
               
            End If
           
        Else
            ' Захват с устройства
            AudioPlayback.StopProcess
           
            If Not InitCapture(frm.SelectedDevice) Then
                InitCapture cur
            Else
                mInpFile = vbNullString
            End If
           
            On Error Resume Next
            AudioCapture.StartProcess
            AudioPlayback.StartProcess
            On Error GoTo 0
           
            If err.Number Then
                MsgBox "Ошибка"
            End If
           
        End If
       
    End If
   
End Sub

' // Изменение АЧХ
Private Sub equResponse_Change()
    Dim data() As Single
   
    ReDim data(mFFTSize \ 2 - 1)
    ' Получаем из контрола
    equResponse.GetCurve data()
    ' Задаем модулятору
    Modulator.SetLevels data()
   
End Sub

' // Загрузка формы
Private Sub Form_Load()
    ' Размер FFT
    mFFTSize = 2048
    ' Перекрытие
    mOverlap = 2
    ' Инициализация воспроизведения
    If Not InitPlayback() Then Unload Me
    ' Инициализация захвата
    If Not InitCapture() Then
        Call btnSettings_Click
    Else
        AudioCapture.StartProcess
    End If
   
    Set plyBuffer = New clsTrickOverlappedBuffer
    Set capBuffer = New clsTrickOverlappedBuffer
    ' Установка перекрывающихся буферов
    plyBuffer.Init mFFTSize, mFFTSize \ mOverlap
    capBuffer.Init mFFTSize, mFFTSize \ mOverlap
   
    Set FFT = New clsTrickFFT
    ' Установка размера БПФ и окна
    FFT.FFTSize = mFFTSize
    FFT.WindowType = WT_HANN
   
    Set Modulator = New clsTrickModulator
    ' Создание буферов
    ReDim tmpCapBuf(1, mFFTSize - 1)
    ReDim tmpPlyBuf(1, mFFTSize - 1)
    ReDim inpBuffer(mFFTSize - 1)
    ReDim outBuffer(mFFTSize - 1)
    ' Обновление информации
    Call equResponse_Change
    Call knbBands_Change
    Call knbMix_Change
    Call knbVolume_Change
    Call knbPitch_Change
    ' Запуск воспроизведения
    AudioPlayback.StartProcess
   
    Dim hRgn    As Long
    ' Задаем регион окну
    hRgn = CreateRoundRectRgn(0, 0, Me.ScaleWidth, Me.ScaleHeight, 2, 2)
    SetWindowRgn Me.hwnd, hRgn, False
    ' Задаем иконку
    SetIcon Me.hwnd
End Sub

' // Получены новые данные с устройства захвата
Private Sub AudioCapture_NewData(ByVal DataPtr As Long, ByVal CountBytes As Long)
    ' Копируем во временный буфер
    memcpy inpBuffer(0), ByVal DataPtr, CountBytes
End Sub

' // Нужны новые данные для воспроизведения
Private Sub AudioPlayback_NewData(ByVal DataPtr As Long, ByVal CountBytes As Long)
    ' Обработка прошлых данных
    Call Process
    ' Копируем
    memcpy ByVal DataPtr, outBuffer(0), CountBytes
End Sub

' // Процесс
Private Sub Process()
    Dim ovrLap      As Long
    Dim ret         As Long
    Dim idx         As Long
    Dim delta       As Single
    Dim datSize     As Long
   
    If Len(mInpFile) Then
        ' Захват из файла
        inpConv.Convert VarPtr(inpBuffer(0)), mFFTSize * 2, ret
        ' Если данные закончились, то начинаем сначала
        If ret < mFFTSize * 2 Then
            inpConv.InputCurrentPosition = 0
            inpConv.Convert VarPtr(inpBuffer(ret \ 2)), mFFTSize * 2 - ret, ret
        End If
       
    End If
    ' Если не задан несущий сигнал
    If wavConv Is Nothing Then
        ' Копируем даные захвата в выходной буфер и выходим
        outBuffer = inpBuffer
        Exit Sub
       
    End If
    ' Преобразовываем данные в комплексный формат
    FFT.Convert16BitToComplex inpBuffer(), tmpCapBuf()
    ' Пишем данные в перекрывающийся буфер
    capBuffer.WriteInputData tmpCapBuf()
    ' Получаем размер (в семплах) несущего сигнала
    datSize = wavConv.Rate * wavConv.InputDataSize \ 2
   
    If datSize < mRawSize Then
        ' Семпл слишком короткий
        wavConv.Convert VarPtr(rawBuffer(0)), mRawSize * 2, ret
        ' Семпл целиком не поместился, начинаем сначала
        If ret * 2 <> datSize Then
       
            wavConv.InputCurrentPosition = 0
            wavConv.Convert VarPtr(rawBuffer(ret \ 2)), datSize * 2 - ret, ret
           
        End If
        ' Зацикливаем его на всю длину буфера
        ret = datSize
        idx = 0
       
        Do While ret < mRawSize
       
            rawBuffer(ret) = rawBuffer(idx)
            ret = ret + 1
            idx = idx + 1
           
        Loop
        ' Обновляем позицию
        wavConv.InputCurrentPosition = ((wavConv.InputCurrentPosition + idx) Mod datSize)
       
    Else
        ' Семпл достаточно длиный
        wavConv.Convert VarPtr(rawBuffer(0)), mRawSize * 2, ret
        ' Если данные закончились, то начинаем сначала
        If ret < mRawSize * 2 Then
       
            wavConv.InputCurrentPosition = 0
            wavConv.Convert VarPtr(rawBuffer(ret \ 2)), mRawSize * 2 - ret, ret
        End If
       
    End If
   
    ' Сжимаем/растягиваем массив с учетом сдвига тона
    delta = 2 ^ (knbPitch.Value / 12)
    For idx = 0 To mFFTSize - 1
        outBuffer(idx) = rawBuffer(Fix(idx * delta))
    Next
    ' Конвертируем данные несущего сигнала в комплексную форму
    FFT.Convert16BitToComplex outBuffer(), tmpPlyBuf()
    ' Пишем данные в перекрывающийся буфер
    plyBuffer.WriteInputData tmpPlyBuf()

    ' Проходы по перекрытиям
    For ovrLap = 0 To mOverlap - 1

        ' Получаем очередные буфера
        capBuffer.GetInputBuffer tmpCapBuf()
        plyBuffer.GetInputBuffer tmpPlyBuf()
        ' Быстрое преобразование Фурье
        FFT.FFT tmpCapBuf(), False
        FFT.FFT tmpPlyBuf(), False
        ' Модуляция
        Modulator.Process tmpPlyBuf(), tmpCapBuf()
        ' Зеркалирование
        FFT.MakeMirror tmpPlyBuf()
        ' Обратное преобразование Фурье
        FFT.FFT tmpPlyBuf(), True
        ' Окно
        FFT.ApplyWindow tmpPlyBuf()
        ' Запись в выход
        plyBuffer.WriteOutputData tmpPlyBuf()

    Next
   
    ' Получаем данные
    plyBuffer.GetOutputBuffer tmpPlyBuf()
    ' Преобразуем
    FFT.ConvertComplexTo16Bit tmpPlyBuf(), outBuffer()
   
End Sub

' // Инициализация захвата звука
Private Function InitCapture(Optional DeviceID As Long = -1) As Boolean
    On Error GoTo ERROR_LABEL
    Set AudioCapture = Nothing
   
    Set AudioCapture = New clsTrickSound
    AudioCapture.InitCapture 1, SampleRate, 16, mFFTSize, DeviceID
   
    InitCapture = True
   
    Exit Function
ERROR_LABEL:
   
    MsgBox "Error initialize capture", vbCritical
   
End Function

' // Инициализация проигрывания звука
Private Function InitPlayback(Optional DeviceID As Long = -1) As Boolean
    On Error GoTo ERROR_LABEL
    Set AudioPlayback = Nothing
   
    Set AudioPlayback = New clsTrickSound
    AudioPlayback.InitPlayback 1, SampleRate, 16, mFFTSize, DeviceID
   
    InitPlayback = True
   
    Exit Function
ERROR_LABEL:
   
    MsgBox "Error initialize playback", vbCritical
   
End Function

' // Нажатие мыши в окне
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim pos As Currency
   
    If y <= 26 Then
        ' Если мышь нажата в пределах заголовка, то включаем перетаскивание
        ReleaseCapture
        GetCursorPos pos
        SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, pos
       
    End If
   
End Sub

' // Изменение количества полос
Private Sub knbBands_Change()
   
    Modulator.Bands = knbBands.Value
    knbBands.Caption = knbBands.Value
   
End Sub

' // Изменение смешивания
Private Sub knbMix_Change()
    Dim lg As Single
    ' Логарифмический масштаб
    lg = ((10 ^ (knbMix.Value / 50)) - 1) / 99
    Modulator.DryWet = lg
    knbMix.Caption = Format(lg, "#0.00%")
       
End Sub

' // Изменение тона несущей
Private Sub knbPitch_Change()
   
    mRawSize = -Int(-mFFTSize * (2 ^ (knbPitch.Value / 12)))
    ReDim rawBuffer(mRawSize - 1)
   
    knbPitch.Caption = Format(knbPitch.Value, "0 sem;-0 sem;non\e")
   
End Sub

' // Изменение громкости
Private Sub knbVolume_Change()
    Dim lg As Single
    ' Логарифмический масштаб
    lg = ((10 ^ (knbVolume.Value / 50)) - 1) / 99
    Modulator.Volume = lg
    knbVolume.Caption = Format(lg, "#0.00%")
           
End Sub

При загрузке формы мы выполняем инициализацию всех компонентов. Захват, воспроизведение звука, размер FFT, величину перекрытия, перекрывающиеся буферы, создание буферов для целочисленных и комплексных данных. Далее я сделал форму окна со скругленными углами, т.к. использую окно без рамки (рисовать в неклиентской области не было желания). Теперь вся задача сводится к обработке событий AudioPlayback_NewData и AudioCapture_NewData. Первое событие возникает когда устройство воспроизведения нуждается в очередной порции звуковых данных, второе при заполнении буфера захвата, в котором мы просто копируем данные во временный буфер откуда потом возьмем их при обработке AudioPlayback_NewData. Самый главный метод - Process, в нем мы непосредственно делаем преобразование. Сначала мы проверяем идет ли у нас захват из файла или устройства. Для этого мы проверяем переменную mInpFile, которая определяет имя входного файла для захвата. Если захват производится из файла, то мы с помощью объекта inpConv, который является экземпляром класса clsTrickWavConverter, конвертируем данные в нужный нам формат. Если данные закончились (число прочитанных байт не соответствует переданному), то значит мы находимся на границе файла и для продолжения нужно начать сначала. Также проверяем несущий сигнал и если он не задан то просто копируем входные данные на выход и выходим, в этом случае мы будем слышать необработанный звук. В противном случае мы переводим данные в комплексный вид (заносим в реальную часть сигнал, а мнимую обнуляем) и заносим полученный массив в перекрывающийся буфер. Далее начинаем обработку несущего сигнала. Т.к. несущий сигнал у нас может быть очень маленькой длины (можно использовать один период волны), то в целях оптимизации я сделаем сами повторение сигнала если это потребуется. Поясню. Например если у нас несущий сигнал длительностью 10 мс, а буфер 100 мс (к примеру), то можно было бы просто каждый раз вызывать конвертацию с помощью ACM переписывая указатель в массиве назначения, но это будет неоптимально. Для оптимизации можно конвертировать только один раз, а потом просто продублировать данные до конца массива, что мы и сделаем. Только потом не забыть изменить позицию в исходном файле, иначе при следующем чтении фазы не будут совпадать и будут щелчки. Писать мы будем в другой буфер (rawBuffer). Этот буфер имеет длину исходя из сдвига тона. Например если мы хотим сдвинуть тон на величину semitones (полутонов), то размер буфера rawBuffer должен быть в 2semitones/12 раза больше. Далее мы просто сожмем/растянем буфер до величины mFFTSize, что даст нам ускорение/замедление и как следствие повышение/понижение тона. После всех манипуляций мы пишем данные в перекрывающийся буфер и начинаем обработку. Для этого проходим по количеству перекрытий и обрабатываем данные. Объекты класса clsTrickOverlappedBuffer вернут нам правильные данные. Обработка понятна из кода, т.к. мы подробно разбирали работу каждого класса. После обработки всех перекрытий мы получаем выходные данные и конвертируем их в целочисленные, пригодные для воспроизведения.
В качестве настройки используется форма frmSettings. В качестве списка устройств используется стандартный листбокс, только отрисовка идет через мой класс. В список устройства добавляются в следующем порядке:
  • Устройство по умолчанию для заданного формата
  • Устройство 1
  • Устройство 2
  • ...
  • Устройство n
  • Захват из файла
Для отработки клика по последнему пункту используется сообщение LB_GETITEMRECT, которое получает координаты и размер пункта в списке. Если этого не сделать то клик за пределами листа, если внизу есть пустое пространство будет равносилен клику на последнем пункте. В обработчике кнопки настроек в главной формы frmTrickVocoder мы проверяем устройство захвата и либо открываем файл для конвертации либо инициализируем захват. Для регулировки громкости и подмешивания используем логарифмическую шкалу, т.к. чувствительность человеческого слуха нелинейна. Вот в принципе и все. Спасибо за внимание.
Изображение
Вложения
TrickVocoder.rar
Исходники, EXE файл и тестовые сигналы.
(1.21 МиБ) Скачиваний: 257
UA6527P

Mikle
Изобретатель велосипедов
Изобретатель велосипедов
Аватара пользователя
 
Сообщения: 4147
Зарегистрирован: 25.03.2003 (Вт) 14:02
Откуда: Туапсе

Re: Вокодер на VB6 часть 2

Сообщение Mikle » 03.12.2014 (Ср) 10:46

Круто звучит, если бы задержка не была такой, как-то же умудряются в Guitar Rig обходиться задержкой в 10 мс.

The trick
Постоялец
Постоялец
 
Сообщения: 774
Зарегистрирован: 26.06.2010 (Сб) 23:08

Re: Вокодер на VB6 часть 2

Сообщение The trick » 03.12.2014 (Ср) 10:51

Mikle, ASIO скорее всего. Я только с помощью него могу добиться маленькой задержки в гитарриг и других vst.
UA6527P


Вернуться в The trick

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 4

    TopList