Nugroho's blog.: Discrete Fourier Transform in Delphi (in progess)

Friday, November 14, 2014

Discrete Fourier Transform in Delphi (in progess)

Here we go...

I plan to coding it in a way that it has flexibility in term of function. So I create two variable ft and ff, represent time domain and frequency domain function as two dimensional array, with the first index as 'function name' so it can be (in future) ft[0,i] as rect(x), ft[1,i] as cos(x) and so on.



unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
StringGrid1: TStringGrid;
Image1: TImage;
Edit1: TEdit;
function fourier(a,k:integer):real;
procedure proses;
procedure fungsi(a:integer);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Image1Click(Sender: TObject);
private{ Private declarations }
public{ Public declarations }
end;
const n=37;m=5;
var
Form1: TForm1;
ft,ff: array[0..m,0..n]of real;
x0,y0:integer;
sx:real=3;
sy:real=17;

implementation

{$R *.dfm}
procedure tform1.fungsi(a:integer);
var i:integer;
begin
for i:=0 to n-1 do begin
ft[a,i]:=cos(i)+cos(2*i);
stringgrid1.Cells[1,i+1]:=inttostr(i);
stringgrid1.Cells[2,i+1]:=floattostr(ft[a,i]);
image1.Canvas.Pen.Color:=clblack;
image1.Canvas.MoveTo(x0+round(sx*i),y0);
image1.Canvas.lineTo(x0+round(sx*i),y0-round(sy*ft[a,i]));
end;
end;
function tform1.fourier(a,k:integer):real;
var i:integer;jml,j:real;
begin
jml:=0;
for i:=0 to n-1 do begin
j:=i;
jml:=jml+ft[a,i]*cos(2*PI*k*j/n);
edit1.Text:=floattostr(jml);
//application.ProcessMessages;sleep(500);
//fm:=fm+1*cos(2*PI*j*i/10/11);
end;
fourier:=jml;
end;

procedure tform1.proses;
var a,i:integer;z:real;
begin
a:=0;
stringgrid1.Cells[3,0]:='f(rect(t))';
for i:=0 to n-1 do begin
ff[a,i]:=fourier(a,i);
stringgrid1.Cells[3,i+1]:=floattostr(ff[a,i]);
stringgrid1.Cells[4,i+1]:=inttostr(round(ff[a,i]));
z:=ff[a,i];
//z:=strtofloat(stringgrid1.Cells[3,i+1]);
image1.Canvas.Pen.Color:=clblue;
image1.Canvas.moveto(x0+round(sx*i),y0);
image1.Canvas.lineTo(x0+round(sx*i),y0-round(sy*z));
stringgrid1.Cells[0,0]:=floattostr(z);
stringgrid1.Cells[0,1]:=inttostr(floor(z));
//application.ProcessMessages;sleep(500);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
proses;
end;

procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
x0:=round(image1.Width/2);
y0:=round(image1.Height/2);
image1.Canvas.pen.Color:=cllime;
image1.Canvas.MoveTo(0,y0);
image1.Canvas.lineto(image1.Width,y0);
image1.Canvas.MoveTo(x0,0);
image1.Canvas.lineto(x0,image1.Height);
stringgrid1.RowCount:=n+1;
//rect(x)
fungsi(0);
//tulis stringgrid
stringgrid1.Cells[0,0]:='no';
stringgrid1.Cells[0,0]:=inttostr(round(1.5));
stringgrid1.Cells[1,0]:='t';
stringgrid1.Cells[2,0]:='rect(t)';

end;

procedure TForm1.Image1Click(Sender: TObject);
begin

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)