Как считать сигнал с микрофона?

Code:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, ComCtrls, MMSystem;

type

TData8 = array [0..127] of byte;

PData8 = ^TData8;

TData16 = array [0..127] of smallint;

PData16 = ^TData16;

TPointArr = array [0..127] of TPoint;

PPointArr = ^TPointArr;

TForm1 = class(TForm)

   Button1: TButton;

   Button2: TButton;

   PaintBox1: TPaintBox;

   TrackBar1: TTrackBar;

   CheckBox1: TCheckBox;

   procedure Button1Click(Sender: TObject);

   procedure Button2Click(Sender: TObject);

   procedure FormDestroy(Sender: TObject);

   procedure CheckBox1Click(Sender: TObject);

   procedure FormCreate(Sender: TObject);

private

   { Private declarations }

public

   procedure OnWaveIn(var Msg: TMessage); message MM_WIM_DATA;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

var

WaveIn: hWaveIn;

hBuf: THandle;

BufHead: TWaveHdr;

bufsize: integer;

Bits16: boolean;

p: PPointArr;

stop: boolean = false;

procedure TForm1.Button1Click(Sender: TObject);

var

header: TWaveFormatEx;

BufLen: word;

buf: pointer;

begin

BufSize := TrackBar1.Position * 500 + 100; { Размер буфера }

Bits16 := CheckBox1.Checked;

with header do begin

   wFormatTag := WAVE_FORMAT_PCM;

   nChannels := 1;  { количество каналов }

   nSamplesPerSec := 22050; { частота }

   wBitsPerSample := integer(Bits16) * 8 + 8; { 8 / 16 бит }

   nBlockAlign := nChannels * (wBitsPerSample div 8);

   nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;

   cbSize := 0;

end;

WaveInOpen(Addr(WaveIn), WAVE_MAPPER, addr(header),

   Form1.Handle, 0, CALLBACK_WINDOW);

BufLen := header.nBlockAlign * BufSize;

hBuf := GlobalAlloc(GMEM_MOVEABLE and GMEM_SHARE, BufLen);

Buf := GlobalLock(hBuf);

with BufHead do begin

   lpData := Buf;

   dwBufferLength := BufLen;

   dwFlags := WHDR_BEGINLOOP;

end;

WaveInPrepareHeader(WaveIn, Addr(BufHead), sizeof(BufHead));

WaveInAddBuffer(WaveIn, addr(BufHead), sizeof(BufHead));

GetMem(p, BufSize * sizeof(TPoint));

stop := true;

WaveInStart(WaveIn);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

if stop = false then Exit;

stop := false;

while not stop do Application.ProcessMessages;

stop := false;

WaveInReset(WaveIn);

WaveInUnPrepareHeader(WaveIn, addr(BufHead), sizeof(BufHead));

WaveInClose(WaveIn);

GlobalUnlock(hBuf);

GlobalFree(hBuf);

FreeMem(p, BufSize * sizeof(TPoint));

end;

procedure TForm1.OnWaveIn;

var

i: integer;

data8: PData8;

data16: PData16;

h: integer;

XScale, YScale: single;

begin

h := PaintBox1.Height;

XScale := PaintBox1.Width / BufSize;

if Bits16 then begin

   data16 := PData16(PWaveHdr(Msg.lParam)^.lpData);

   YScale := h / (1 shl 16);

   for i := 0 to BufSize - 1 do

     p^[i] := Point(round(i * XScale),

       round(h / 2 - data16^[i] * YScale));

end else begin

   Data8 := PData8(PWaveHdr(Msg.lParam)^.lpData);

   YScale := h / (1 shl 8);

   for i := 0 to BufSize - 1 do

     p^[i] := Point(round(i * XScale),

       round(h - data8^[i] * YScale));

end;

with PaintBox1.Canvas do begin

   Brush.Color := clWhite;

   FillRect(ClipRect);

   Polyline(Slice(p^, BufSize));

end;

if stop

   then WaveInAddBuffer(WaveIn, PWaveHdr(Msg.lParam),

     SizeOf(TWaveHdr))

   else stop := true;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

Button2.Click;

end;

procedure TForm1.CheckBox1Click(Sender: TObject);

begin

if stop then begin

   Button2.Click;

   Button1.Click;

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

TrackBar1.OnChange := CheckBox1Click;

Button1.Caption := 'Start';

Button2.Caption := 'Stop';

CheckBox1.Caption := '16 / 8 bit';

end;

end.