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

Инфразвук (создание буфера данных и воспроизведение)

Чт мар 09, 2023 11:00:26

Я сейчас занимаюсь экспериментами с интерференцией света и мне надо с частотой менее 1 Гц плавно изменять положение зеркальца весом 10-ть грамм, которое крепится к диффузору динамика. В Интернете я нашел программу WaveFuncBas написанную на языке Visual Basic 6.0, которая делала то, что мне надо, но отказывалась генерировать звук менее 2 Гц. К тому же и аудиокарта моего ноутбука и внешняя аудиокарта Edifier GS 02 (вернее сказать их ЦАП) отказывались пропускать звук с частотой менее 20...30 Гц. С аудиокартой мне помог mont-oriol, который сообщил, что у него аудиокарта от наушников Nokia hs-82 воспроизводит инфразвук. Я нашел такие наушники, перепаял разъем micro USB-A на USB 2.0-A, а выводы на наушники запараллелил и подключил к ним динамик 4 Вт (4 Ома). А вот с генерацией звука частотой менее 2 Гц с использованием моей программы у меня сейчас проблема. При выводе сигнала частотой 2 Гц из двух буферов данных (сначала из 1-го, потом из 2-го, потом из 1-го и т.д.) все идет нормально (см. фото 1), а при выводе частоты 1 Гц получается не то, что я ожидал (см. фото 2), хотя в самих буферах данных записан сигнал именно для 1 Гц (я проверял, выведя данные на график).

Изображение

А понять, почему так происходит мне помог вариант вывода на динамик сигнала только из одного буфера данных (см. фото 3). Здесь получается, что данные выводятся только из первой половины буфера данных и поэтому при выводе данных с частотой 2 Гц, когда у нас в буфере (стандартная длительность звучания которого 1 секунда) записаны два периода синусоиды, у нас выводится за пол секунды один период из 1-го буфера, а потом за пол секунды 1 период из 2-го буфера, т.е. за одну секунду выводится два периода и поэтому мы и наблюдаем то, что нам надо. А при выводе данных для частоты 1 Гц на динамик сначала идет первая половина синусоиды из 1-го буфера, а потом опять же первая половина синусоиды из 2-го буфера (см. фото 2). Причем, дело тут не в особенностях ЦАПа Nokia hs-82, т.к. точно так же и при использование внешнего ЦАПа Edifier GS 02 и внутреннего ЦАПа ноутбука при проигрывание только одного буфера данных (с частотой 400...10000 Гц) выводится звук только из первой половины буфера, а потом такое же время звук отсутствует.

Изображение

Исходя из этой особенности работы моей программы генератора сигнала я придумал, как можно вывести сигнал частотой менее 2 Гц. Для этого надо просто увеличить размер буфера данных так, чтобы у него в первой половине был записан полный период колебаний с нужной мне частотой. Например, для вывода частоты 1 Гц я задаю частоту 2 Гц и увеличиваю размер буфера в два раза. В результате у меня теперь время звучания буфера будет 2 секунды, а половины буфера 1 секунду и в этой половине будет записан ровно один период синусоиды, что мы и видим на фото 4. Точно также для частоты 1/2 Гц надо при заданной частоте 2 Гц увеличить размер буфера в 4-е раза, а для частоты 1/4 Гц в 8-мь раз и т.д.

Таким образом, решение вроде найдено, но оно меня не очень устраивает, т.к. иногда на стыках данных двух буферов возникают небольшие искажения, что мне не желательно. К тому же, когда я не полностью понимаю как работает программа я не могу быть уверен в том, что она не преподнесет во время проведения экспериментов какой то еще сюрприз. Поэтому хотелось бы понять почему у меня программа воспроизводит только половину буфера данных. Кстати, гуляющие по Интернету программы генераторов (исполняемые файлы exe), например, generator.exe тоже при малых частотах работают некорректно, хотя при частотах несколько сотен или тысяч Гц эти погрешности незаметны. Теперь переходим непосредственно к коду моей программы, который я в следующем сообщение дам только основными частями, т.к. сама программа содержит еще и код для синхронной работы с генератором звука вэбкамеры, а этот код нас не интересует.

С наилучшими пожеланиями Сергей Юдин.

Добавлено after 2 hours 30 minutes 59 seconds:
Я здесь даю код и из формы 1 и из модулей, где даны функции API и некоторые подпрограммы (они объявлены публичными). Cами функции API, а так же константы, переменные и типы данных приведу в следующем сообщение (может быть кому то они пригодятся). Последовательность здесь такая. При загрузке формы 1 определяются все имеющиеся устройства для работы с аудио данными, а потом в ComboBox выбираем нужное нам. При этом в FormatDate задается структура файла данных и при открытие нужного нам устройства проверяется поддерживает ли оно этот формат. Затем при запуске генератора инициализируется устройство вывода, и создаются два буфера данных, размер которых корректируется с учетом коэффициента kSpeed, о котором я писал в первом сообщение и который позволяет воспроизводить звук частотой менее 2 Гц. Далее в подпрограмме FillBuffer эти два буфера заполняются данными для воспроизведения синусоидального сигнала, где Alfa это начальная фаза синусоиды, а время tPred я там оставил, как было в исходном коде, но вообще то оно в моем варианте не нужно. И потом эти буферы запускаются один за другим на выполнение. При этом буферы воспроизводятся по кругу один за другим до тех пор пока не будет команды остановить.

Код:
Private Sub Form_Load()
Dim NumDevs As Integer
NumDevs = waveOutGetNumDevs() '         Определяем количество waveform-аудио выходных устройств в системе
'                                               Определяем характеристики каждого waveform-аудио выходного устройства
For X = -1 To NumDevs - 1 '    и название устройства записываем в ComboBox начиная с Wave Mapper(WAVE_MAPPER = -1)
  If MMSYSERR_NOERROR = waveOutGetDevCaps(X, woc, Len(woc)) Then
   Combo1.AddItem woc.szPname, X + 1
  End If
Next X
Combo1.Text = Combo1.List(0)
Initialize Me.hWnd
End Sub

Public Sub Initialize(hwndIn As Long)
    hWnd = hwndIn
    lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case uMsg
   Case MM_WOM_DONE
   OutWaveThRun
   Case MM_WOM_CLOSE
      Form1.Label1.Caption = "А тут Устройство закрыто"
   Case MM_WOM_OPEN
     Form1.Label1.Caption = "Опять Устройство открыто"
End Select
   WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Function

Private Sub Combo1_Click() '   Проверяем, поддерживает ли выбранное устройство формат заложенный в wf
FormatDate
If MMSYSERR_NOERROR = waveOutOpen(0, Combo1.ListIndex - 1, wf, vbNull, 0, WAVE_FORMAT_QUERY) Then
  Label1.Caption = "Формат поддерживается"
Else
  Label1.Caption = "Формат не поддерживается"
End If
End Sub

Private Sub FormatDate() '                        заполнение структуры формата буфера данных
Dim SpS&, BpS&
BpS = Text14.Text: SpS = Text15.Text
With wf
  .wFormatTag = WAVE_FORMAT_PCM '                                        используется PCM формат
  .nChannels = 1                '                                                  это моносигнал (1 канал)
  .nSamplesPerSec = SpS '  44100   '                                      частота дискретизации 11,025-22,05-44,1 Кгц
  .wBitsPerSample = BpS   '  16      '                                                выборка 16 бит
  .nAvgBytesPerSec = (wf.nChannels * wf.nSamplesPerSec * wf.wBitsPerSample) / 8 ' число байт в секундном интервале для моносигнала
  .nBlockAlign = (wf.nChannels * wf.wBitsPerSample) / 8 '      1 * 16 / 8= 2   число байт в выбоке для моносигнала
  .cbSize = Len(wf) '                                                              не используется (можно .cbSize = 0)
End With
End Sub

Private Sub Command20_Click() '  включить генератор сигнала и, если включена запись, то пишем в файлы картинки
f = Text4.Text: omega = 2 * pi * f: Period = 1 / f : dVol=32767 '    частота, период и амплитуда колебаний
kSpeed = Text27.Text  '                коэффициент увеличения буфера данных, т.е. для уменьшения заданной частоты
OutWaveThInit '  инициализируем устройство вывода, задаем размер буферов с учетом kSpeed и создаем эти буферы
tPred = 0 '
FillBuffer Buffer1, tPred '                            заполняем два буфера данными для заданного сигнала
FillBuffer Buffer2, tPred
waveOutWrite hWaveOut, whdr1, Len(whdr1) '                                             выводим данные буфера 0
waveOutWrite hWaveOut, whdr2, Len(whdr2) '                                             выводим данные буфера 1
End Sub

Public Sub OutWaveThInit() '                      Процедура init'а звукового потока (Открываем устройство вывода звука)
If MMSYSERR_NOERROR = waveOutOpen(hWaveOut, Form1.Combo1.ListIndex - 1, wf, hWnd, True, CALLBACK_WINDOW) Then
Form1.Label1.Caption = "Устройство открыто"
BufferSize = wf.nBlockAlign * wf.nSamplesPerSec * 0.5 * kSpeed '                  Определяем размер буферов с учетом kSpeed

ReDim Buffer1(BufferSize - 1) '                        задаем размерность массивов буферов
ReDim Buffer2(BufferSize - 1)
      With whdr1
.lpData = VarPtr(Buffer1(0))
.dwBufferLength = BufferSize
'.dwBytesRecorded = 0
'.dwUser = 0
'.dwFlags = WHDR_BEGINLOOP Or WHDR_ENDLOOP Or WHDR_DONE
'.dwLoops = 1
'.lpNext = vbNull
'.Reserved = 0
      End With
      With whdr2
.lpData = VarPtr(Buffer2(0))
.dwBufferLength = BufferSize
'.dwBytesRecorded = 0
'.dwUser = 0
'.dwFlags = WHDR_BEGINLOOP Or WHDR_ENDLOOP Or WHDR_DONE
'.dwLoops = 1
'.lpNext = vbNull
'.Reserved = 0
      End With
waveOutPrepareHeader hWaveOut, whdr1, Len(whdr1)
waveOutPrepareHeader hWaveOut, whdr2, Len(whdr2)
End If
End Sub

Public Sub FillBuffer(ByRef Buf() As Integer, ByRef tPred As Double)’      заполняем буфер данными
For X = 0 To BufferSize - 1
tt = X / wf.nSamplesPerSec / kSpeed + tPred
If Form1.Option1.Value = True Then Buf(X) = Round(dVol * Sin(omega * tt + Alfa))
Next X
tPred = tt
End Sub

Private Sub Command4_Click() '  выключить генратор сигнала
OutWaveThStop
End Sub


С наилучшими пожеланиями Сергей Юдин.

Добавлено after 5 minutes 39 seconds:
функции API, а так же константы, переменные и типы данных для программы генератора

Код:
Public Const MAXPNAMELEN = 32     'max product name length (including NULL)
Public Const MMSYSERR_NOERROR = 0 'Нет ошибок
Public Const CALLBACK_WINDOW = &H10000
Public Const CALLBACK_EVENT = &H50000
Public Const WAVE_FORMAT_QUERY = &H1
Public Const WAVE_ALLOWSYNC = &H2
Public Const MM_WOM_CLOSE = &H3BC
Public Const MM_WOM_DONE = &H3BD
Public Const MM_WOM_OPEN = &H3BB  'waveform output
Public Const WHDR_BEGINLOOP = &H4 'loop start block
Public Const WHDR_DONE = &H1      'done bit
Public Const WHDR_ENDLOOP = &H8   'loop end block
Public Const WAVE_FORMAT_PCM = 1
Public Const GMEM_MOVEABLE = &H2
Public Const GMEM_SHARE = &H2000
Public Const pi = 3.14159265358979
Public Const GWL_WNDPROC = -4
Public whdr1 As WAVEHDR      'header звукового буфера N1
Public whdr2 As WAVEHDR      'header звукового буфера N2
Public BufferSize As Long    '    Размер буфера
Public Buffer1() As Integer  '      Буферы для звуковых данных (в зависимости от формата данных в wf,
Public Buffer2() As Integer ‘       буферы будут иметь разный размер, поэтому динамические массивы)
Public woc As WAVEOUTCAPS
Public wf As WAVEFORMATEX
Public hWaveOut As Long
Public tPred As Double, T0 As Double, T0pred As Double '
Public hWnd As Long
Public lpPrevWndProc As Long
Public X As Long, i As Long, ii As Long, j As Long, k As Long, kk As Long
Public t As Double, tt As Double, f As Double, dVol As Double
Public MT As Double, Vmax As Double
Public omega As Double
Public Alfa#, Info$ '                                  вспомогательный угол
Public kUgol#, kSignal# '  коэффициент перевода из градусов в радины и тангенс угла наклона треугольного сигнала
Public kSpeed& '                                       коэффициент уменьшения скорости воспроизведения
Public Period# '                                       период


Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function waveOutGetDevCaps Lib "winmm.dll" Alias "waveOutGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As WAVEOUTCAPS, ByVal uSize As Long) As Long
Public Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long

Public Declare Function waveOutOpen Lib "winmm.dll" (lphWaveOut As Long, ByVal uDeviceID As Long, lpFormat As WAVEFORMATEX, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Public Declare Function waveOutPrepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long

Public Declare Function waveOutReset Lib "winmm.dll" (ByVal hWaveOut As Long) As Long
Public Declare Function waveOutPause Lib "winmm.dll" (ByVal hWaveOut As Long) As Long
Public Declare Function waveOutRestart Lib "winmm.dll" (ByVal hWaveOut As Long) As Long

'Public Declare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long
Public Declare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, lpWaveOutHdr As Any, ByVal uSize As Long) As Long

Public Declare Function waveOutWrite Lib "winmm.dll" (ByVal hWaveOut As Long, lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long
Public Declare Function waveOutClose Lib "winmm.dll" (ByVal hWaveOut As Long) As Long

Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long

Public Type WAVEOUTCAPS 'Структура для waveOutGetDevCaps
        wMid As Integer
        wPid As Integer
        vDriverVersion As Long
        szPname As String * MAXPNAMELEN
        dwFormats As Long
        wChannels As Integer
        dwSupport As Long
End Type

Type WAVEFORMATEX        'Структура для waveOutOpen
        wFormatTag As Integer
        nChannels As Integer
        nSamplesPerSec As Long
        nAvgBytesPerSec As Long
        nBlockAlign As Integer
        wBitsPerSample As Integer
        cbSize As Integer
End Type

Public Type WAVEHDR
        lpData As Long
        dwBufferLength As Long
        dwBytesRecorded As Long
        dwUser As Long
        dwFlags As Long
        dwLoops As Long
        lpNext As Long
        Reserved As Long
End Type


С наилучшими пожеланиями Сергей Юдин.

Re: Инфразвук (создание буфера данных и воспроизведение)

Чт мар 09, 2023 19:32:04

Сергей, вот ещё генератор на VB6:
Там есть ограничение на минимальную частоту в 20 Гц, его легко изменить.
Оно сначала строит один период с нужной частотой, пишет его во временный файл, затем запускает его на бесконечное воспроизведение.
Я попробовал воспроизведение синуса 0.1 Гц. Оно работает. Но вот что интересно - создание файла заняло больше минуты. У меня WIN запущена в виртуальной машине, что тоже затормаживает процесс, но... Это наводит на мысль, что VB тормозной и не успевает в реальном времени генерировать синусы, отсюда и глюки.
Посмотрел ещё на треугольник из этой программы. Он глючный, если temp.wav открыть в редакторе, то там такое
Изображение
Но сам подход кажется правильным.

Re: Инфразвук (создание буфера данных и воспроизведение)

Пт мар 10, 2023 12:07:08

Я попробовал воспроизведение синуса 0.1 Гц. Оно работает. Но вот что интересно - создание файла заняло больше минуты. У меня WIN запущена в виртуальной машине, что тоже затормаживает процесс, но... Это наводит на мысль, что VB тормозной и не успевает в реальном времени генерировать синусы, отсюда и глюки.


За код спасибо. Может быть что то из него и пригодится, но сама идея использовать библиотеки DirectX 7 или DirectX 8 мне кажется не очень удачной, т.к. там используется еще какая то оскулирующая частота. Например, смотрите вот эти два проекта Sine_Wave_19480411132005 и WaveManip, в которых используется библиотека DirectX 7. В первом проекте кроме изменения частоты звука можно создавать эффект 3D звука, а во втором кроме изменения частоты звука можно периодически изменять его громкость. Но создание частоты в них делается однотипно с использованием какой то оскулирующей частоты 330 Гц. Что это такое я так и не понял и поэтому отказался от этого варианта. А в вашей программе, где используется библиотека DirectX 8 вообще трудно разобраться как генерируется звук. К тому же, хоть она и дает чистую синусоиду, но как фон идет звук с какой то частотой (может быть с той самой 330 Гц, о которых говорится в двух первых проектах). Так что этот вариант, быстрее всего, не пройдет. К тому же там треугольный и пилообразный сигнал дает явные щелчки (наверное в треугольном сигнале ошиблись на изгибах на несколько шагов). Да, еще. У меня ваша программа работает без всяких задержек и в чистой Windows XP на ноутбуке и в виртуальной на настольном компьютере.

А вот моя программа, как ни странно, заработала без всяких сбоев. Я стал упрощать исходный код программы WaveFuncBas и заметил, что программа при загрузке формы обращается к подпрограмме Initialize а там обращается к WindowProc, где зачем то запускает один буфер данных обращаясь к подпрограмме OutWaveThRun. Там неизвестно как заполняется один из буферов данными и запускается, но ведь еще не произошла инициализация самих буферов в OutWaveThInit, где определяется и размер этих буферов. Поэтому мне не понятна эта процедура, но без нее сгенерированный звук звучит только одну секунду.

Поэтому я сейчас в своем варианте этой программы WebCamGen убрал подпрограмму OutWaveThRun, а сами буферы так же заполняю данными в FillBuffer и потом запускаю оба буфера используя waveOutWrite. Но теперь в WindowProc при загрузке формы запускаю не один, а два пустых буфера waveOutWrite. При этом я два модуля исходного кода программы DeclaresAPI.bas и Subclassing.bas объединил в один DeclaresAPI.bas. Там у меня в программе много лишнего кода, связанного с работой вэбкамеры. На него не обращайте внимания. И еще. Пока генератор запускается только при работе циклов вэбкамеры в режиме GetTickCount и генерирует только синусоиду. Частота пусть остается 2 Гц, а делить ее, чтобы получить частоту 1-0,5-0,25 Гц надо на 2-4-8. Чтобы включилась кнопка пуска генератора, надо выбрать аудиоустройство вывода звука и при этом можно запускать как один буфер (не отмечен чекбокс + Buffer2) так и оба буфера. Результат почему то получается один и тот же. Интересно будет узнать как моя программа будет работать на вашем компьютере.

С наилучшими пожеланиями Сергей Юдин.
Вложения
WebCamGen_05_03_23_new2.rar
(35.27 KiB) Скачиваний: 44
WaveFuncBas.rar
(13.81 KiB) Скачиваний: 40
WaveManip.rar
(2.83 KiB) Скачиваний: 40
Sine_wave_19480411132005.rar
(3.71 KiB) Скачиваний: 39

Re: Инфразвук (создание буфера данных и воспроизведение)

Пт мар 10, 2023 14:44:32

Интересно будет узнать как моя программа будет работать на вашем компьютере.

Синус, вроде, нормальный. А треугольник смещён, там есть постоянная составляющая, и он половинной амплитуды. Явная ошибка, думаю, разберётесь.
Изображение
Изображение
Изображение
Изображение
Кстати, эта HS-82 поддерживает частоту дискретизации только 48 кГц, а если там что-то иное, то WIN будет перекодировать. Поэтому, лучше сразу использовать 48 кГц.

Re: Инфразвук (создание буфера данных и воспроизведение)

Сб мар 11, 2023 07:08:32

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

Там не ошибка. Просто я треугольный сигнал не доделал. А в том виде, как он сделан сейчас, амплитуда будет нормальной если поменять местами два провода на входе в осциллограф (по крайней мере у меня получается так).

Кстати, эта HS-82 поддерживает частоту дискретизации только 48 кГц, а если там что-то иное, то WIN будет перекодировать. Поэтому, лучше сразу использовать 48 кГц.

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

С наилучшими пожеланиями Сергей Юдин.
Ответить