Сигнал со звуковой карты - Delphi & Builder

Здравствуйте, MrOduvanchik, Вы писали:

MO>Всем привет!

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

На график на мой взгляд "реального времени" и не надо — вполне пойдёт с задержкой в 150 — 200 милисекунд (вполне можно сделать на MM API). А если действительна нужно мгновенно.. хмм.. Тогда ставь ASIO драйвера, API к ним тоже под Delphi где-то видел.. С ними можно получить задержку менее 50 мс, но практически не вижу смысла в такой реалтаймовости..

Здравствуйте, Hacker_Delphi, Вы писали:

H_D>Здравствуйте, MrOduvanchik, Вы писали:

MO>>У кого нибуть есть наработки либо идеи работы на эту тему.

H_D>копать в сторону waveIn, DirectSound, DelphiX....

С последним понятно где, а первые 2 смотреть в МСДН? Есть линки? Можно англоязычные тоже...

Здравствуйте, Dimonka, Вы писали:

D>На график на мой взгляд "реального времени" и не надо — вполне пойдёт с задержкой в 150 — 200 милисекунд (вполне можно сделать на MM API). А если действительна нужно мгновенно.. хмм.. Тогда ставь ASIO драйвера, API к ним тоже под Delphi где-то видел.. С ними можно получить задержку менее 50 мс, но практически не вижу смысла в такой реалтаймовости..

Если можно тоже, где про это можно в сети почитать? и про MM API, и про ASIO драйвера.

я хотел бы извенится, что сразу не ответил. Были некоторые проблемы с инернетом.Нл вроде сейчас уже все нормально!

Здравствуйте, MrOduvanchik, Вы писали:

D>>На график на мой взгляд "реального времени" и не надо — вполне пойдёт с задержкой в 150 — 200 милисекунд (вполне можно сделать на MM API). А если действительна нужно мгновенно.. хмм.. Тогда ставь ASIO драйвера, API к ним тоже под Delphi где-то видел.. С ними можно получить задержку менее 50 мс, но практически не вижу смысла в такой реалтаймовости..

MO>Если можно тоже, где про это можно в сети почитать? и про MM API, и про ASIO драйвера.

В Delphi открываешь меню Help, а в нём Windows SDK. По индексу ищешь Recording Waveform Audio. Там всё подробно описано и с примерами.

Здравствуйте, MrOduvanchik, Вы писали:

MO>У кого нибуть есть наработки либо идеи работы на эту тему.

Простенький пример:

const
  WavBufferSize      = 160; // В данном случае у тебя 16 бит/на семпл * 8000 семплов в сек = 16000 байт (см. Format). 
                            // При размере буфера в 160 байт Callback функция будет вызываться 100 раз в секунду. ИМХО хватит.
  NumberOfBuffers    = 4;
type
   PWaveBuffer = ^TWaveBuffer;
   TWaveBuffer = record
    Index    : Integer;
    Handle   : HWAVE; 
    Header   : TWaveHdr;
    Buffer   : packed array[0..Pred(WavBufferSize)] of Byte;
  end;
  
  TWaveBuffers = array[1..NumberOfBuffers] of TWaveBuffer;
var
  Format: TWaveFormatEx;
  Handle: HWAVE; 
  FBuffers: TWaveBuffers;
begin
  Format.wFormatTag      := WAVE_FORMAT_PCM;
  Format.nChannels       := 1;
  Format.nSamplesPerSec  := 8000;
  Format.nAvgBytesPerSec := 8000;
  Format.nBlockAlign     := 1;
  Format.wBitsPerSample  := 16;

  waveInOpen(@Handle, 0, @Format, Cardinal(@WaveInCallBack), Cardinal(Self), CALLBACK_FUNCTION);  

  for i := 1 to NumberOfBuffers do
  begin
    FillChar(FBuffers[i].Buffer,WavBufferSize,0);
    FBuffers[i].Index                  := i;
    FBuffers[i].Handle                 := Handle;
    FBuffers[i].Header.dwFlags         := 0;
    FBuffers[i].Header.lpData          := @FBuffers[i].Buffer;
    FBuffers[i].Header.dwBytesRecorded := 0;
    FBuffers[i].Header.dwUser          := Cardinal(@FBuffers[i]);
    FBuffers[i].Header.dwLoops         := 1;
    FBuffers[i].Header.dwBufferLength  := WavBufferSize;
    waveInPrepareHeader(Handle,@FBuffers[i].Header, SizeOf(TWaveHdr));
    waveInAddBuffer(Handle,@FBuffers[i].Header, SizeOf(TWaveHdr));
  end;
  waveInStart(Handle);  
end;


procedure WaveInCallBack(DeviceHandle: HDRVR; uMsg: UINT; dwUserData: DWORD; dwParam1, dwParam2: DWORD); stdcall;
var
  Header: PWaveHdr;
  Buffer: PWaveBuffer;
begin
  if not (uMsg = WIM_DATA) then Exit;
  
  Header := PWaveHdr(dwParam1);
  Buffer := PWaveBuffer(Header.dwUser);

  // Тут разбираешь то, что записано и рисуешь график. 
  
  // Возвращаем буфер в очередь  
  if (Header.dwFlags and WHDR_PREPARED) <> 0 then waveInUnprepareHeader(Buffer.FHandle,@Buffer.Header, SizeOf(TWaveHdr));
  Buffer.Header.dwFlags         := 0;
  Buffer.Header.dwBytesRecorded := 0;
  waveInPrepareHeader(Buffer.FHandle,@Buffer.Header, SizeOf(TWaveHdr));
  waveInAddBuffer(Buffer.FHandle, @Buffer.Header, SizeOf(TWaveHdr));
end;

2 All: Кстати, тут обсуждалась тема передачи в качестве stdcall callback-функции метода обьекта, так вот у меня передать в waveInOpen методом, слизаным с TLanguages, не удалось — вылетает access viol. Any ideas?

Здравствуйте, KaBoom, Вы писали:

[Skip]

KB>2 All: Кстати, тут обсуждалась тема передачи в качестве stdcall callback-функции метода обьекта, так вот у меня передать в waveInOpen методом, слизаным с TLanguages, не удалось — вылетает access viol. Any ideas?

Вылетит если ты строил CallbackThunk в локальной переменной...
Если же это не так то проверь правильность соглашений вызовов.

Я же для этого дела набросал себе небольшой класик (привожу полный юнит):

unit DCallBack;

interface

type
  IDCallBackThunk = interface
  ['{E36BB842-AD8F-4645-8E7B-87F7003DF622}']
    function GetCallBack: Pointer;
    function GetInstance: TObject;
    property CallBack: Pointer read GetCallBack;
    property Instance: TObject read GetInstance;
  end;

  CoCallBack = class
    class function CreateThunk (const Method : TMethod) : IDCallBackThunk; overload;
    class function CreateThunk (Instace : TObject; Method : Pointer) : IDCallBackThunk; overload;
  end;


implementation

type
  TCallbackThunkRec = packed record
    POP_EDX    : Byte;
    MOV_EAX    : Byte;
    SelfPtr    : Pointer;
    PUSH_EAX   : Byte;
    PUSH_EDX   : Byte;
    JMP        : Byte;
    JmpOffset  : Integer;
  end;

  TDCallBackThunk = class(TInterfacedObject, IDCallBackThunk)
  private
    FCallBack : TCallbackThunkRec;
    FInstance: TObject;
    function GetCallBack: Pointer;
    function GetInstance: TObject;
  public
    constructor Create (Method : TMethod);
    property CallBack: Pointer read GetCallBack;
    property Instance: TObject read GetInstance;
  end;

//==================================================================================================
// class TDCallBackThunk
//==================================================================================================

constructor TDCallBackThunk.Create(Method: TMethod);
begin
  inherited Create;
  FInstance := Method.Data;

  FCallback.POP_EDX   := $5A;
  FCallback.MOV_EAX   := $B8;
  FCallback.SelfPtr   := Method.Data;
  FCallback.PUSH_EAX  := $50;
  FCallback.PUSH_EDX  := $52;
  FCallback.JMP       := $E9;
  FCallback.JmpOffset := Integer(Method.Code) - Integer(@FCallback.JMP) - 5;
end;

function TDCallBackThunk.GetCallBack: Pointer;
begin
  Result := @FCallback;
end;

function TDCallBackThunk.GetInstance: TObject;
begin
  Result := FInstance;
end;

//==================================================================================================
// class CoCallBack
//==================================================================================================

class function CoCallBack.CreateThunk(const Method : TMethod): IDCallBackThunk;
begin
  Result := TDCallBackThunk.Create(Method);
end;

class function CoCallBack.CreateThunk(Instace: TObject;
  Method: Pointer): IDCallBackThunk;
var
  aMethod : TMethod;
begin
  aMethod.Data := Instace;
  aMethod.Code := Method;
  Result := CreateThunk(aMethod);
end;

end.

Тестовый клас:

interface
uses
  DCallBack;

type
  TCallBackTest = class
  private
    FCallBack : IDCallBackThunk;
  protected
    procedure SomeCallBackMethod (Param1, Param2 : Integer); stdcall;
  public
    constructor Create;
    procedure Init;
  end;

implementation

type
  TSomeCallBack = procedure (Param1, Param2 : Integer); stdcall;

procedure SomeAPIInitFunc (Callback : Pointer); stdcall;
begin
  TSomeCallBack (Callback) (1, 2); { тестовый вызов }
end;

{ TCallBackTest }

constructor TCallBackTest.Create;
begin
  FCallBack := CoCallBack.CreateThunk (Self, @TCallBackTest.SomeCallBackMethod);
end;

procedure TCallBackTest.Init;
begin
  SomeAPIInitFunc (FCallBack.CallBack);
end;

procedure TCallBackTest.SomeCallBackMethod(Param1, Param2 : Integer);
begin
  ShowMessage (Format ('ClassName:%s, Param1: %d, Param2: %d', [ClassName, Param1, Param2]));
end;

И использование тестового класа:

procedure TForm1.Button1Click(Sender: TObject);
begin
  with TCallBackTest.Create do
    try
      Init;
    finally
      Free;
    end;
end;

Здравствуйте, Danchik, Вы писали:

[Skip]

D>Вылетит если ты строил CallbackThunk в локальной переменной...

+10

Сделал его полем обьекта — все заработало!

Все же мне непонятно — почему оно в TLanguages работает? Я там не лазил, не смотрел, но по логике в таком варианте коллбек может вызываться только до отработки конструктора...

Здравствуйте, KaBoom, Вы писали:

KB>Здравствуйте, Danchik, Вы писали:

KB>[Skip]

D>>Вылетит если ты строил CallbackThunk в локальной переменной...

KB>+10

Сделал его полем обьекта — все заработало!

KB>Все же мне непонятно — почему оно в TLanguages работает? Я там не лазил, не смотрел, но по логике в таком варианте коллбек может вызываться только до отработки конструктора...

Потому что в TLanguages callback вызывается до окончания работы процедуры, что для TLanguages совсем достаточно.
При выходе же из процедуры Стек может протерется соответственно CallbackThunk становится невалидным, а API функция при попытке вызвать CallBack натыкается на мусор, что и приводит к AV.

Кстати, об этом я и писал здесь

	От:	MrOduvanchik
	Дата:	18.10.05 02:42
	Оценка:

	От:	Hacker_Delphi
	Дата:	18.10.05 05:49
	Оценка:

	От:	Dimonka
	Дата:	18.10.05 07:54
	Оценка:

	От:	MrOduvanchik
	Дата:	20.10.05 12:46
	Оценка:

	От:	MrOduvanchik
	Дата:	20.10.05 12:49
	Оценка:

	От:	KaBoom
	Дата:	21.10.05 07:58
	Оценка:

	От:	Danchik
	Дата:	21.10.05 11:59
	Оценка: