Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 16.01.2011, 09:17   #1
sniper70
Новичок
Джуниор
 
Регистрация: 16.02.2010
Сообщений: 1
По умолчанию как из этого БПФ выдрать частоту

имеется код а как найти частоту тут не знаю помогите пожалуйста

Код:
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.

Последний раз редактировалось Stilet; 16.01.2011 в 10:31.
sniper70 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как выдрать из текста вес ??? kakawkin Общие вопросы Delphi 2 18.10.2010 20:08
Как изменить частоту монитора? LoRD_ОЛЕДЖАН Компьютерное железо 1 30.09.2009 19:53
Как изменить частоту воспроизводимого WAV звука chandrasecar Мультимедиа в Delphi 3 29.12.2008 15:11
как выдрать ссылку и html???? Kitt Работа с сетью в Delphi 8 26.04.2008 12:50
Как изменять частоту железа?? UnD)eaD)Snake Общие вопросы Delphi 6 30.07.2007 15:06