Как можно получить звук с микрофона?

Материал из DRKB

Как можно получить звук с микрофона?[править | править код]

unit receiver;

interface

uses mmsystem, Classes;

const
  samp_per_sec = 44100;
  samp_cnt = samp_per_sec div 5;
  buf_len = samp_cnt * 2;

type
  PSample16M = ^TSample16M;
  TSample16M = SmallInt;
  PArrayOfSample = ^TArrayOfSample;
  TArrayOfSample = array[1..samp_cnt] of TSample16M;

  TReceiver = class
  private
    hwi: Integer;
    fmt: tWAVEFORMATEX;
    whdr1: WAVEHDR;
    buf1: TArrayOfSample;
    whdr2: WAVEHDR;
    buf2: TArrayOfSample;
    FStoped: Boolean;
    FOnChange: TNotifyEvent;
    procedure SetStoped(const Value: Boolean);
  public
    Peak: Integer;
    Buffer: PArrayOfSample;
    destructor Destroy; override;
    procedure Start;
    procedure Stop;
    property Stoped: Boolean read FStoped write SetStoped;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

var
  rec: TReceiver;

implementation

procedure waveInProc(const hwi, uMsg, dwInstance: Integer; var hdr: WAVEHDR;
  const dwP2: Integer); stdcall;
const
  divs = samp_cnt div 100;
var
  i, p: Integer;
  buf: PArrayOfSample;
begin
  if rec.Stoped then
    Exit;
  case uMsg of
    WIM_OPEN:
    begin
    end;
    WIM_DATA:
    begin
      rec.Buffer := PArrayOfSample(hdr.lpData);
      buf := PArrayOfSample(hdr.lpData);
      p := 0;
      for i := 0 to samp_cnt div divs do
        p := p + Abs(buf[i * divs]);
      rec.Peak := p div (samp_cnt div divs);
      if Assigned(rec.FOnChange) then
        rec.FOnChange(rec);
      waveInUnprepareHeader(hwi, @hdr, SizeOf(WAVEHDR));
      waveInPrepareHeader(hwi, @hdr, SizeOf(WAVEHDR));
      waveInAddBuffer(hwi, @hdr, SizeOf(WAVEHDR));
    end;
    WIM_CLOSE:
    begin
    end;
  end;
end;

{ TReceiver }

destructor TReceiver.Destroy;
begin
  Stoped := True;
  inherited;
end;

procedure TReceiver.SetStoped(const Value: Boolean);
begin
  FStoped := Value;
  if Value then
  begin
    waveInStop(hwi);
    waveInUnprepareHeader(hwi, @whdr1, SizeOf(WAVEHDR));
    waveInUnprepareHeader(hwi, @whdr2, SizeOf(WAVEHDR));
    waveInReset(hwi);
    waveInClose(hwi);
  end
  else
  begin
    with fmt do
    begin
      wFormatTag := WAVE_FORMAT_PCM;
      nChannels := 1;
      nSamplesPerSec := samp_per_sec;
      nBlockAlign := 2;
      nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
      wBitsPerSample := 16;
      cbSize := 0;
    end;
    waveInOpen(@hwi, WAVE_MAPPER, @fmt, cardinal(@waveInProc), hInstance, CALLBACK_FUNCTION);
    with whdr1 do
    begin
      lpData := @buf1;
      dwBufferLength := buf_len;
      dwBytesRecorded := 0;
      dwUser := 0;
      dwFlags := 0;
      dwLoops := 0;
      lpNext := nil;
      reserved := 0;
    end;
    waveInPrepareHeader(hwi, @whdr1, SizeOf(WAVEHDR));
    waveInAddBuffer(hwi, @whdr1, SizeOf(WAVEHDR));
    with whdr2 do
    begin
      lpData := @buf2;
      dwBufferLength := buf_len;
      dwBytesRecorded := 0;
      dwUser := 0;
      dwFlags := 0;
      dwLoops := 0;
      lpNext := nil;
      reserved := 0;
    end;
    waveInPrepareHeader(hwi, @whdr2, SizeOf(WAVEHDR));
    waveInAddBuffer(hwi, @whdr2, SizeOf(WAVEHDR));
    waveInStart(hwi);
  end;
end;

procedure TReceiver.Start;
begin
  Stoped := False;
end;

procedure TReceiver.Stop;
begin
  Stoped := True;
end;

initialization
  rec := TReceiver.Create;

finalization
  rec.Free;
end.


вот. отображать уровень можно через поле Peak при событии OnChange, там же (в этом событии) можно работать с полем Buffer в котором как раз содержится записанный сигнал.

Вся работа осуществляется через глобальную переменную rec. Возможно это не лучшая реализация с точки зрения ООП, но работает Запись происходит с глубиной 16 бит и частотой 44100 в режиме моно. После небольшой переделки все это может работать с любыми частотами и каналами и глубинами.


Author: cully
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02255