имеется код а как найти частоту тут не знаю помогите пожалуйста
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, fftbase, fftfilterconst, MMSystem, StdCtrls, ExtCtrls;
type
TData16 = array [0..255] of smallint;
PData16 = ^TData16;
TPointArr = array [0..255] of TPoint;
PPointArr = ^TPointArr;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
PaintBoxFFT: TPaintBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
procedure OnWaveIn(var Msg: TMessage); message MM_WIM_DATA;
end;
Const
BufSize = 256;
var
Form1: TForm1;
p: PPointArr;
stop: boolean = false;
Bits16: boolean;
hBuf: THandle;
data16: PData16;
fDataBuf: array [0..BufSize] of SmallInt;
WaveIn: hWaveIn;
BufHead: TWaveHdr;
implementation
{$R *.dfm}
procedure MakeFFT; {Процедура самого преобразования}
var
fftb: TFFTBase; //класс, который реализует БПФ
fFFTComplBuf: ^TComplexArray; //Буфер для хранения комплексных величин
i: integer;
begin
GetMem(fFFTComplBuf, BufSize*SizeOf(TComplex)); //Выделение памяти под массив
for i:=0 to BufSize-1 do //Заполняем данными массив
begin
fFFTComplBuf[i].Re := fDataBuf[i];
fFFTComplBuf[i].Im := 0;
end;
fftb:=TFFTBase.Create(nil);
//FFT - выполнение БПФ
//Параметры задаваемые процедуре :
//указатель на массив данных (с комплексными числами)
//N - количество данных (размерность массива)
//2^X=N (степень числа два)
//False – прямое преобразование; True – обратное
//Тип окна:
// 0-прямоугольное
// 1-треугольное
// 2-Хэминга
// 3-Ханна
// 4-Блэкмана
fftb.FFT(Pointer(fFFTComplBuf), BufSize, 8, false, 0);
for i:=0 to BufSize-1 do //Переносим результат БПФ в исходный массив
begin
fDataBuf[i] := Round(fFFTComplBuf[i].Re / 500); //заполняем массив выходными значениями (предварительно масштабируем их)
end;
fftb.Free;
FreeMem(fFFTComplBuf, BufSize*SizeOf(TComplex)); //Освобождение памяти выделенной под массив
end;
procedure DrawFFT; {Прорисовка результата на PaintBox}
var
i, tmpY: integer;
begin
for i:=0 to Trunc((BufSize/2)-1) do {Чтоб небыло "зеркального" результата берем только половину массива}
begin
tmpY := Form1.PaintBoxFFT.Height - Round(fDataBuf[i]);
Form1.PaintBoxFFT.Canvas.LineTo(i, tmpY);
end;
Form1.PaintBoxFFT.Canvas.MoveTo(0, Form1.PaintBoxFFT.Height);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
header: TWaveFormatEx;
BufLen: word;
buf: pointer;
begin
with header do
begin
wFormatTag := WAVE_FORMAT_PCM;
nChannels := 2; {Количество каналов: 1-Моно , 2-Стерео}
nSamplesPerSec := 192000; {Частота дискретизации}
wBitsPerSample := 8 ; {Разрядность , бит}
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;
begin
Data16 := PData16(PWaveHdr(Msg.lParam)^.lpData);
for i := 0 to BufSize - 1 do
fDataBuf[i]:= Data16^[i];
Form1.PaintBoxFFT.Refresh;
MakeFFT(); {Выполним преобразование}
DrawFFT(); {Отобразим результат}
if stop then
WaveInAddBuffer(WaveIn, PWaveHdr(Msg.lParam), SizeOf(TWaveHdr))
else
stop := true;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Button2.Click;
end;
end.