Fourier Transform using Delphi

 It's not Discrete Fourier Transform.

 Instead, I use continue definition (using Integral, not Sum) to compute the transformation. I know, it's weird, but it's worth a try, :)

 What I did is transform signal with 3 frequency, remove the two frequency and trasform back to time-signal.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    Memo1: TMemo;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    procedure proses;
    procedure gambarFungsi;
    procedure gambarSumbu;
    procedure gambarTransformasi;
    procedure olahTransformasi;
    procedure gambarOlahTransformasi;
    procedure transformasiBalik;
    procedure gambarTransformasibalik;
    function f(x:real):real;
    procedure Timer1Timer(Sender: TObject);
  private
  public
  end;

const
  a=200;
  b=150;

var
  Form1: TForm1;
  x0,y0,xm,ym:integer;
  s,ss:array[-a..a]of real;
  ft:array[-b..b]of real;
implementation
{$R *.dfm}
function tform1.f(x:real):real;
begin
  f:=cos(PI*x)+cos(2*PI*x)+cos(4*PI*x);
end;
procedure tform1.transformasiBalik;
var i,j:integer;
t,w,dt:real;
begin{}
  dt:=0.1;
  for i:=-a to a do begin
    w:=i/10;
    ss[i]:=0;
    for j:=-b to b do begin
      t:=j/10;
      ss[i]:=ss[i]+ft[j]*cos(w*t)*dt
    end;
  end;
  gambarTransformasiBalik;
end;

procedure tform1.olahTransformasi;
var i:integer;
begin
  for i:=-b to b do begin
    if abs(i)>50 then ft[i]:=0;
  end;
  gambarOlahTransformasi;
end;

procedure tform1.proses;
var i,j:integer;
t,w,dt:real;
begin
  form1.Caption:='transformasi';
  gambarSumbu;
  {transformasi}
  dt:=0.1;
  for i:=-a to a do begin
    s[i]:=f(i/30);
  end;
  for i:=-b to b do begin
    w:=i/10;
    ft[i]:=0;
    for j:=-a to a do begin
      t:=j/10;
      ft[i]:=ft[i]+f(t)*cos(w*t)*dt
    end;
  end;
  gambarFungsi;
  gambarTransformasi;
  olahTransformasi;
  transformasiBalik;
end;

procedure tform1.gambarFungsi;
var i,xo,yo,xt,yt:integer;
begin
  xo:=-a; yo:=0;
  for i:=-a to a do begin
    xt:=i;
    yt:=round(10*s[i]);
    with image1.Canvas do begin
      moveto(x0+xo,y0-yo);lineto(x0+xt,y0-yt);
    end;
    xo:=xt;
    yo:=yt;
  end;
end;

procedure tform1.gambarTransformasibalik;
var i,xo,yo,xt,yt:integer;
begin
  xo:=-a; yo:=0;
  for i:=-a to a do begin
    xt:=i;
    yt:=round(10*ss[i]);
    with image4.Canvas do begin
      moveto(x0+xo,y0-yo);lineto(x0+xt,y0-yt);
    end;
    xo:=xt;
    yo:=yt;
  end;
end;

procedure tform1.gambarOlahTransformasi;
var i,xo,yo,xt,yt:integer;
begin
{}
  xo:=-b; yo:=0;
  for i:=-b to b do begin
    xt:=i;
    yt:=round(10*ft[i]);
    with image3.Canvas do begin
      moveto(x0+xo,y0-yo);lineto(x0+xt,y0-yt);
    end;
    xo:=xt;
    yo:=yt;
  end;
end;

procedure tform1.gambarTransformasi;
var i,xo,yo,xt,yt:integer;
begin
  xo:=-b;yo:=0;
  for i:=-b to b do begin
    xt:=i;
    yt:=round(10*ft[i]);
    with image2.Canvas do begin
      moveto(x0+xo,y0-yo);lineto(x0+xt,y0-yt);
    end;
    xo:=xt;
    yo:=yt;
  end;
end;

procedure tform1.gambarSumbu;
begin
  x0:=image1.Width div 2;
  y0:=image1.Height div 2;
  xm:=image1.Width;
  ym:=image1.Height;
  with image1.Canvas do begin
    moveto(0,y0);lineto(xm,y0);moveto(x0,0);lineto(x0,ym);
  end;
  with image2.Canvas do begin
    moveto(0,y0);lineto(xm,y0);moveto(x0,0);lineto(x0,ym);
  end;
  with image3.Canvas do begin
    moveto(0,y0);lineto(xm,y0);moveto(x0,0);lineto(x0,ym);
  end;
  with image4.Canvas do begin
    moveto(0,y0);lineto(xm,y0);moveto(x0,0);lineto(x0,ym);
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  timer1.Enabled:=false;
  proses;
end;

end.