ufft.pas

DELPHI写的FFT程序

unit Ufft;

interface


uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, fftunit, ExtCtrls, StdCtrls;

const dn= 128;
type
  TForm1 = class(TForm)
    Image1: TImage;
    ScrollBar1: TScrollBar;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
   procedure Draw(var f : realarray);
   procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
   function  index(x: integer): integer;
    procedure ScrollBar1Change(Sender: TObject);
  private
    { Private declarations }
    xstart, xslut, mx, my : integer;
    offset : integer;
    tr, ti : realarray;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure tform1.Draw(var f : realarray);
var i : integer;
begin
  with image1, image1.canvas do
  begin
  mx := width;
  my := image1.height;
  brush.color := clwhite;
  rectangle(0,0,mx, my);
  moveto(0, mx div 2);
  for i := 1 to N do
  begin
    {r  := (sqr(fr[i]) + sqr(fi[i]));}
    {if i mod modus = 0 then}
    lineto(ROUND(I / N*MX), round(my div 2 - f[i]*my / 4));
  end;
  end;
end;

function  tform1.index(x: integer): integer;
begin
  index := round(x/mx* n);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  init(10);
  offset := 1;
  draw(fr);
  fft(fr, fi, LnN, -1);
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i : integer;
begin
end;

procedure TForm1.ScrollBar1Change(Sender: TObject);
var i, keep : integer;
begin
  with scrollbar1 do
  if position <=50 then
  LargeChange := 1 else
  LargeChange := 50;
  keep := round(scrollbar1.position/1000*N) div 2;
  {fft(fr,fi, LnN, 1);}
  tr := fr;
  ti := fi;
  for i := 1+keep to N-keep do
  begin
    tr[i] := 0;
    ti[i] := 0;
  end;
  fft(tr,ti, LnN, 1);
  draw(tr);
end;


end.