unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, MMSystem, StdCtrls, ExtCtrls;
type
TData16 = array [0..127] of smallint;
PData16 = ^TData16;
TPointArr = array [0..127] of TPoint;
PPointArr = ^TPointArr;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
RichEdit1: TRichEdit;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
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;
p: PPointArr;
stop: boolean = false;
z: integer;
procedure TForm1.OnWaveIn;
var
data16: PData16;
begin
sleep(z); {выставляем промежутки времени}
data16 := PData16(PWaveHdr(Msg.lParam)^.lpData);
RichEdit1.Lines.Add(IntToStr(data16[0]));
if stop then
WaveInAddBuffer(WaveIn, PWaveHdr(Msg.lParam), SizeOf(TWaveHdr))
else
stop := true;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
header: TWaveFormatEx;
BufLen: word;
buf: pointer;
begin
z:= StrToInt(Edit1.Text);
RichEdit1.Clear;
BufSize := 1; { Размер буфера }
with header do
begin
wFormatTag := WAVE_FORMAT_PCM;
nChannels := 1; { количество каналов }
nSamplesPerSec := 22050; { частота }
wBitsPerSample := 16; { 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.FormDestroy(Sender: TObject);
begin
Button2.Click;
end;
end.
Если Вы уже зарегистрированы на Портале - войдите в систему, если Вы еще не регистрировались - пройдите простую процедуру регистрации.