Nugroho's blog.: Fourier Transform using Delphi

Saturday, October 3, 2015

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.

No comments:

323f (5) amp (1) android (12) apple (7) arduino (18) art (1) assembler (21) astina (4) ATTiny (23) blackberry (4) camera (3) canon (2) cerita (2) computer (106) crazyness (11) debian (1) delphi (39) diary (286) flash (8) fortran (6) freebsd (6) google apps script (8) guitar (2) HTML5 (10) IFTTT (7) Instagram (7) internet (12) iOS (5) iPad (6) iPhone (5) java (1) javascript (1) keynote (2) LaTeX (6) lazarus (1) linux (29) lion (15) mac (28) macbook air (8) macbook pro (3) macOS (1) Math (3) mathematica (1) maverick (6) mazda (4) microcontroler (35) mountain lion (2) music (37) netbook (1) nugnux (6) os x (36) php (1) Physicist (29) Picture (3) programming (189) Python (109) S2 (13) software (7) Soliloquy (125) Ubuntu (5) unix (4) Video (8) wayang (3) yosemite (3)