Текущий архив: 2013.06.09;
Скачать: CL | DM;

Вниз

Захват звука с микрофона и 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

---

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

> maxistent


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

---

← →
maxistent ©   (2009-01-11 18:54) [14]

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

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

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

---

← →
Eraser ©   (2009-01-11 21:51) [15]

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


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

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

---

← →
Сергей М. ©   (2009-01-12 08:16) [16]

> maxistent


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

---

← →
maxistent ©   (2009-01-12 09:25) [17]

:)  Спасибо.

---

Страницы: 1 вся ветка

Текущий архив: 2013.06.09;
Скачать: CL | DM;

Наверх

Память: 0.52 MB
Время: 0.008 c