Захват звука с микрофона и ACM-Components

← →
maxistent © (2009-01-03 19:19) [0]

Здравствуйте Уважаемые. У меня вот какая проблемка:
Для захвата звука с микрофона я использую компонент TACMWaveIn. Заметил одну неприятную особенность: данные "приходят" только ОДИН РАЗ В СЕКУНДУ. в инете видел кучу примеров получения звука с микрофона - там поток данных приходит десятки раз в секунду :( но в тех примерах я не могу установить формат в GSM6.10 (не работает). может что не так делал-не знаю. если есть у кого примеры с GSM6.10 и частотой > 1 раз в секунду поделитесь, PLZ!

← →
maxistent © (2009-01-03 19:44) [1]

Вот, например, "подходящий" код. Непрерывный поток приходит десятки раз в секунду... но формат GSM6.10 не могу поставить :(

:

unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Forms, Dialogs, MMSystem, ScktComp, MSACM, ExtCtrls, zlibex, Controls, StdCtrls; type TWavArrayBuf = array[0..1023]of byte; PWavArrayBuf = ^TWavArrayBuf; TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private procedure WndProc(var Msg: TMessage); override; function InitWaveIn: Boolean; procedure CloseWaveIn; end; var Form1: TForm1; WaveHdr: PWaveHdr; WavBuff: PWavArrayBuf; WaveIn: PHWaveIn; implementation uses Math; {$R *.dfm} function TForm1.InitWaveIn: Boolean; var I, Err: Integer; maxsizeformat,res:longint; WaveFormat: TWaveFormatEx; procedure FreeData; begin if WavBuff <> nil then Dispose(WavBuff); if WaveHdr <> nil then Dispose(WaveHdr); if WaveIn <> nil then Dispose(WaveIn); end; begin Result := False; WaveFormat.wFormatTag := WAVE_FORMAT_PCM; //здесь нужно поставить GSM6.10 (вроде бы $31) WaveFormat.nChannels := 1; WaveFormat.nSamplesPerSec := 8000; WaveFormat.nAvgBytesPerSec := 8000; WaveFormat.nBlockAlign := 1; WaveFormat.wBitsPerSample := 8; WaveIn := New(PHWaveIn); Err := WaveInOpen(WaveIn, 0, @WaveFormat, Handle, 0, CALLBACK_WINDOW or WAVE_MAPPED); if Err <> 0 then begin Application.MessageBox(PChar("Error: "+IntToStr(Err)+": "+SysErrorMessage(GetLastError)),"Error",0); Exit; end; for i:=1 to 8 do begin WavBuff := New(PWavArrayBuf); WaveHdr := New(PWaveHdr); with WaveHdr^ do begin lpData := Pointer(WavBuff); dwBufferLength := SizeOf(WavBuff); dwBytesRecorded := 0; dwUser := 0; dwFlags := 0; dwLoops := 0; end; Err := WaveInPrepareHeader(WaveIn^, WaveHdr, SizeOf(TWaveHdr)); if Err <> 0 then begin Application.MessageBox(PChar("Error: "+IntToStr(Err)+": "+SysErrorMessage(GetLastError)),"Error",0); FreeData; Exit; end; Err := WaveInAddBuffer(WaveIn^, WaveHdr, Sizeof(TWaveHdr)); if Err <> 0 then begin Application.MessageBox(PChar("Error: "+IntToStr(Err)+": "+SysErrorMessage(GetLastError)),"Error",0); FreeData; Exit; end; end; Err := WaveInStart(WaveIn^); if Err <> 0 then begin Application.MessageBox(PChar("Error: "+IntToStr(Err)+": "+SysErrorMessage(GetLastError)),"Error",0); FreeData; Exit; end; Result := True; end; Procedure Tform1.WndProc(var Msg: TMessage); var Hdr: PWaveHdr; I: Integer; R: Real; begin inherited; case Msg.Msg of MM_WIM_DATA: begin Hdr := PWaveHdr(Msg.LParam); if Hdr^.dwBytesRecorded = 0 then Exit; R := IfThen(Hdr^.dwBytesRecorded > 0, ClientWidth / Hdr^.dwBytesRecorded, 0); PatBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight, PATCOPY); Canvas.Pen.Color:=clRed; Canvas.MoveTo(0, 127); Canvas.LineTo(ClientWidth, 127); Canvas.Pen.Color := clMaroon; for I := 1 to 12 do begin Canvas.MoveTo(Round(R * (I * 100)), 0); Canvas.LineTo(Round(R * (I * 100)), 255); end; Canvas.Pen.Color:=clLime; Canvas.MoveTo(0, PWavArrayBuf(Hdr.lpData)^[0]); for I := 0 to Hdr^.dwBytesRecorded - 1 do Canvas.LineTo(Round(R * I), PWavArrayBuf(Hdr.lpData)^[I]); WaveInUnprepareHeader(WaveIn^, Hdr, Sizeof(TWaveHdr)); Dispose(hdr.lpData); DisPose(hdr); Hdr := New(PWaveHdr); Hdr^.lpData := Pointer(New(PWavArrayBuf)); Hdr^.dwBufferLength := 1024; Hdr^.dwBytesRecorded := 0; Hdr^.dwUser := 0; Hdr^.dwFlags := 0; Hdr^.dwLoops := 0; WaveInPrepareHeader(WaveIn^, Hdr, Sizeof(TWaveHdr)); WaveInAddBuffer(WaveIn^, Hdr, Sizeof(TWaveHdr)); end; end; end; procedure TForm1.CloseWaveIn; begin WaveInStop(WaveIn^); if WaveIn <> nil then begin WaveInReset(WaveIn^); WaveInClose(WaveIn^); end; Dispose(WaveIn); end; procedure TForm1.FormCreate(Sender: TObject); begin DoubleBuffered := True; Height := 282; Width := 1000; Color := clBlack; if not InitWaveIn then ShowMessage(SysErrorMessage(GetLastError)); end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin CloseWaveIn; end; end.

← →
Сергей М. © (2009-01-03 20:42) [2]

http://www.torry.net/authorsmore.php?id=2148
deAudio v.2.8

← →
maxistent © (2009-01-03 21:27) [3]

Прошу прощения, но эти компоненты не работают! я скачал архив с сайта, установил (с горем пополам!). примеры не работают. поставил на форму deAudioIN - а он ничего не выдает :( а АКТИВ делал, и ОУПЕН, и т.д. ... как с него данные "выцепить"? может компонент "битый"? Если у Вас есть рабочий, скиньте пожалисто! Буду оч рад :)

← →
maxistent © (2009-01-03 21:58) [4]

сорри, уже разобрался. работает. СПАСИБО :)

← →
Сергей М. © (2009-01-03 22:24) [5]

У меня работают. С теми же самыми примерами, из того же самого архива, в той же самой Д7.

> АКТИВ делал

Исключение не возникло ? После "деланья" "АКТИВ" равен ТРУ ?

Значит все работает.

← →
maxistent © (2009-01-11 15:03) [6]

Теперь возникла другая проблема: при длительном сеансе записи и воспроизведения с помощью этих компонентов происходит торможение, т.е. воспроизведение ОПАЗДЫВАЕТ. Я беру звук с микрофона, передаю его по сети, и на другом конце воспроизвожу. После нескольких минут ощущается существенная задержка. :( Как с этим бороться? Кто знает?

← →
Сергей М. © (2009-01-11 15:18) [7]

deAudio-компоненты тут совершенно ни причем.

← →
maxistent © (2009-01-11 15:32) [8]

нет, я про них ничего и не говорю :) я просто интересуюсь, как проблемку эту побороть? :) Почему происходит постепенное запаздывание? если делать "сброс" компонентов - то все восстанавливается, но опять со временем появляется задержка :( Может компонент для воспроизведения не успевает обрабатывать входной поток? тогда как его приостанавливать? :( ничего не пойму...

← →
Сергей М. © (2009-01-11 16:04) [9]

> Может компонент для воспроизведения не успевает обрабатывать
> входной поток?

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

← →
maxistent © (2009-01-11 16:57) [10]

Возможно, сеть тормозит поток. А можно это как-то компенсировать?

← →
Сергей М. © (2009-01-11 17:11) [11]

> можно это как-то компенсировать?

Без искажения оригинальной АЧХ - никак.

← →
Сергей М. © (2009-01-11 17:38) [12]

Компенсация врем.задержки (безусловно в допустимый ущерб качеству трансляции) достигается минимизацией трафика между передатчиком и приемником инф.потока.
Минимизация трафика достигается:
- на прикладном уровне - эффективными высокопроизводительными алгоритмами кодирования/декодирования аудиоданных + компрессии/декомпрессии транслируемого потока,
- на транспортном уровне - использованием протоколов без гарантии доставки
- на сетевом уровне - принятием возможных мер к эффективной маршрутизации инф.пакетов + эффективное использование QoS

> maxistent

Короче говоря, приличный сетевой "матюгальник" - штука далеко не тривиальная, одним только шмякаьем компонентов на форму здесь никак не обойтись - требуется основательная теоретическая подкова)

> - на транспортном уровне - использованием протоколов без
> гарантии доставки

ТОЧНО! я же TCP-IP использовал! он-то как раз за гарантированную доставку отвечает! наверно поэтому поток и тормозит... надо с удп попробывать.. :)

ладно, будем думать... СПАСИБО!

> [14] maxistent © (11.01.09 18:54)

> надо с удп попробывать

делай сразу на мультикасте, хотя это почти тоже самое что и УДП.

> maxistent

Небольшой ликбез по IGMP:
http://book.itep.ru/4/44/igmp_449.htm

:) Спасибо.

Захват звука с микрофона и ACM-Components Найти похожие ветки