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

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 в режиме моно. После небольшой переделки все это может работать с любыми частотами и каналами и глубинами.

Автор cully
Взято с Vingrad.ru






Содержание раздела

---

---