Returning Function as Array in Delphi

Do you wonder how to do vector operation in Delphi? No, of course, :).

We could go like this.

function tform1.adv(a,b:real):real;
begin
adv:=a+b;
end;

The problem is the return is real, which is single value only. We want a and b as vector. Wait…

How we define vector in Delphi? I don’t know. I used to treat a vector in Delphi as array. So I coded it like this

var a,b:array[0..1]of real;

So far I had no problem. Lately, I am going crazy with overuse functions in Delphi, and trying operating vectors using function too.

But if I write the code like this

function tform1.adv(a,b:array[0..1]of real):real;
begin
adv:=a[0]+b[0];
{a[1]+b[1]?}
end;

It will only return one value. So I improvised by modify it

like this

function tform1.adv(a,b:array[0..1]of real):array[0..1]ofreal;
begin
adv[0]:=a[0]+b[0];
adv[1]:=a[1]+b[1];
end;

But it won’t compile. (it will give error message “identifier expected but ARRAY found”). So I try another approach

type
vector=array[0..1] of real;

function tform1.adv(a,b:vector):vector;
begin
adv[0]:=a[0]+b[0];
adv[1]:=a[1]+b[1];
end;

It works, :).

Here my last night tinkering with “vector” in Delphi, 🙂

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Math;
type
vector=array[0..1] of real;

type
TForm1 = class(TForm)
procedure proses;
function mux(a:real;b:vector):vector;
function dot(a,b:vector):real;
function norm(a,b:vector):vector;
function adv(a,b:vector):vector;
function suv(a,b:vector):vector;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const
n=3;
var
Form1: TForm1;
r,v:array[1..n] of vector;
implementation

{$R *.dfm}
function tform1.adv(a,b:vector):vector;
begin
adv[0]:=a[0]+b[0];
adv[1]:=a[1]+b[1];
end;
function tform1.suv(a,b:vector):vector;
begin
suv[0]:=a[0]-b[0];
suv[1]:=a[1]-b[1];
end;
function tform1.mux(a:real;b:vector):vector;
begin
mux[0]:=a*b[0];
mux[1]:=a*b[1];
end;

function tform1.dot(a,b:vector):real;
begin
dot:=a[0]*b[0]+a[1]*b[1];
end;
function tform1.norm(a,b:vector):vector;
var mag,i,j:real;
begin
i:=b[0]-a[0];
j:=b[1]-a[1];
mag:=sqrt(power(i,2)+power(j,2));
if mag<>0 then begin
norm[0]:=i/mag;
norm[1]:=j/mag;
end;
end;
procedure tform1.proses;
var direction:vector;
vi,vj,swap:real;
i,j:integer;
begin
j:=2;i:=1;
direction:=norm(r[j],r[i]);//call function
vi:=dot(v[i],direction);
vj:=dot(v[j],direction);
swap:=vj-vi;
v[i]:=adv(v[i],mux(swap,direction));
v[j]:=suv(v[j],mux(swap,direction));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
proses;
end;

end.

Delphi: Click a Cell on Stringgrid to Toggle its Value

Here we are. The code below is a part of (unfinished) array of JK flip-flop that draw the output on stringgrid. The problem is, we want to change input (J and K) at  the runtime which is easy if the code is not flexible (just add several button), but as we can see, the code is flexible so there is big no no for the manually added button. So we want to click the corresponding cell and the value changed (in this case toggled, 1 to 0 or otherwise).

Here the code

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
StringGrid1: TStringGrid;
procedure proses;
function toStr(a:boolean):string;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
private{ Private declarations }
public{ Public declarations }
end;
const n=5;
var
Form1: TForm1;
J,K,Q,nQ:array[0..n-1]of boolean;
clock:boolean=true;
jalan:boolean=false;
implementation

{$R *.dfm}
function tform1.toStr(a:boolean):string;
begin
toStr:=inttostr(-1*strtoint(booltostr(a)));
end;
procedure tform1.proses;
var i:integer;
begin
if clock=false then begin
//flip-flop1
if J[0]<>k[0] then Q[0]:=J[0] else begin
if J[0]=true then Q[0]:= not Q[0];
end;
nQ[0]:=not Q[0];
for i:=0 to n-1 do begin
stringgrid1.Cells[2,i+1]:=tostr(J[i]);
stringgrid1.Cells[3,i+1]:=tostr(K[i]);
stringgrid1.Cells[4,i+1]:=tostr(Q[i]);
stringgrid1.Cells[5,i+1]:=tostr(nQ[i]);
end;
end;
stringgrid1.Cells[1,1]:=tostr(clock);

end;
procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
for i:=0 to n-1 do begin
J[i]:=false;
K[i]:=false;
Q[i]:=false;
nQ[i]:=false;
end;
stringgrid1.ColCount:=6;
stringgrid1.RowCount:=6;
stringgrid1.Cells[1,0]:='clock';
stringgrid1.Cells[2,0]:='J';
stringgrid1.Cells[3,0]:='K';
stringgrid1.Cells[4,0]:='Q';
stringgrid1.Cells[5,0]:='nQ';
for i:= 1 to n do begin
stringgrid1.Cells[0,i]:='FlipFlop'+inttostr(i);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
jalan:=not jalan;
while jalan = true do begin
clock:=not clock;
proses;
application.ProcessMessages;sleep(300);
end;
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
var i:integer;
begin
if ACol=2 then begin
for i:=1 to n do begin
if ARow=i then begin
J[ARow-1]:=not J[ARow-1];
stringgrid1.Cells[2,i]:=toStr(J[Arow-1]);
end;
end;
end;
if ACol=3 then begin
for i:=1 to n do begin
if ARow=i then begin
K[ARow-1]:=not K[ARow-1];
stringgrid1.Cells[3,i]:=toStr(K[Arow-1]);
end;
end;
end;

end;

end.

Here the result

Digital Counter with Reset and Preset/Clear

This code’s updated version from flexible one (whic is by itself is updated version from this) 🙂 .

It has added feature so we could reset the counter if it reach a certain denary (decimal, it is 🙂 ) and preset it to certain denary.

To be able to do that we have to convert the denary to binary and distribute it among Q[0] to Q[n-1].

Here the code

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
StringGrid1: TStringGrid;
function toString(var a:boolean):string;
function denary:string;
function toBool(a:integer):boolean;
procedure proses;
procedure tlsStrgrd;
procedure deRes(a:integer);
procedure dePres(a:integer);
procedure resPres(a:integer);
procedure counter(l:integer);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const n=6;
var Form1: TForm1;
Q,Qr,Qp:array[0..n-1]of boolean;
l:integer=0;o:integer=0;
jalan:boolean=false;clock:boolean=true;
implementation{$R *.dfm}
procedure tform1.resPres(a:integer);
var i:integer;
begin
if o<=n-1 then begin
if Q[a]=Qr[a] then begin
o:=o+1;
if o=n then begin
for i:=0 to n-1 do Q[i]:=Qp[i];
end else resPres(o);
end;
end;
end;
function tform1.toBool(a:integer):boolean;
begin
if a=1 then toBool:=true else toBool:=false;
end;
procedure tform1.deRes(a:integer);var i:integer;
begin
a:=a+1;
for i:=0 to n-1 do begin
Qr[i]:=toBool(a mod 2);
a:=a div 2;
end;
end;
procedure tform1.dePres(a:integer);var i:integer;
begin
for i:=0 to n-1 do begin
Qp[i]:=toBool(a mod 2);
a:=a div 2;
end;
end;
function tform1.denary; var i,j:integer;begin
j:=0;
for i:=0 to n-1 do begin
j:=j+round(strtoint(toString(Q[i]))*Power(2,i));
end;
denary:=inttostr(j);
end;
function tform1.toString(var a:boolean):string;begin
toString:=inttostr(-1*strtoint(booltostr(a)));
end;
procedure tform1.counter(l:integer);begin
if l<=n-1 then begin
Q[l]:=not Q[l];
if Q[l]=false then begin
l:=l+1;
counter(l);
end;
end;
{menghitung biner tempat mereset}
deRes(13);
{di-reset ke nilai berapa (dalam biner)}
dePres(11);
{masukkan ke sini}
o:=0;
resPres(o);
end;
procedure tform1.tlsStrgrd;var i:integer;begin
for i:=0 to n-1 do begin
stringgrid1.Cells[i+2,1]:=toString(Q[i]);
end;end;
procedure tform1.proses;
begin
clock:=not clock;
if clock=false then
begin
l:=0;
counter(l);
tlsStrgrd;
end;
stringgrid1.Cells[1,1]:=toString(clock);
stringgrid1.Cells[n+2,1]:=denary;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
jalan:= not jalan;
while jalan=true do begin
proses;
application.ProcessMessages;sleep(300);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
stringgrid1.ColCount:=n+3;
stringgrid1.Cells[1,0]:='clock';
stringgrid1.Cells[n+2,0]:='denary';
stringgrid1.Cells[n+2,1]:=denary;
stringgrid1.Cells[1,1]:=toString(clock);
for i:=0 to n-1 do begin
Q[i]:=false;
stringgrid1.Cells[i+2,0]:='Q'+inttostr(i);
stringgrid1.Cells[i+2,1]:=toString(Q[i]);
end;
end;
end.
<pre>

Discrete Fourier Transform

It’s not flexible one.

unit Unit1;

interface

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

type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
BitBtn1: TBitBtn;
Edit1: TEdit;
procedure proses;
procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure tform1.proses;
var i,j:integer;
fm:real;
begin
for i:=0 to 50 do begin
fm:=0;
for j:=0 to 10 do begin
{untuk fungsi rect(x)}
fm:=fm+1*cos(2*PI*j*i/10/11);
end;
stringgrid1.Cells[0,i+1]:=floattostr(i);
stringgrid1.Cells[1,i+1]:=floattostr(i/10);
stringgrid1.Cells[2,i+1]:=floattostr(fm);
edit1.Text:=floattostr(fm);
application.ProcessMessages;sleep(200);
f(x)=cos(x)+cos(2x)+cos(3x)+cos(4x)}
end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
proses;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
stringgrid1.RowCount:=51;
stringgrid1.Cells[0,0]:='no';
stringgrid1.Cells[1,0]:='m';
stringgrid1.Cells[2,0]:='f[m]';
//stringgrid1.Cells[3,0]:='no';
end;

end.

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.

Flexible Digital Counter using Delphi (with Recursive Procedure)

Updated version from before

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
StringGrid1: TStringGrid;
function toString(var a:boolean):string;
function denary:string;
procedure proses;
procedure tlsStrgrd;
procedure counter(l:integer);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const n=5;
var Form1: TForm1;
Q:array[0..n-1]of boolean;
l:integer=0;
jalan:boolean=false;
clock:boolean=true;

implementation{$R *.dfm}

function tform1.denary;
var i,j:integer;
begin
j:=0;
for i:=0 to n-1 do begin
j:=j+round(strtoint(toString(Q[i]))*Power(2,i));
end;
denary:=inttostr(j);
end;

function tform1.toString(var a:boolean):string;begin
toString:=inttostr(-1*strtoint(booltostr(a)));
end;

procedure tform1.counter(l:integer);
begin
if l<=n-1 then begin
Q[l]:=not Q[l];
if Q[l]=false then begin
l:=l+1;
counter(l);
end;
end;
end;

procedure tform1.tlsStrgrd;
var i:integer;
begin
for i:=0 to n-1 do begin
stringgrid1.Cells[i+2,1]:=toString(Q[i]);
end;
end;

procedure tform1.proses;
begin
clock:=not clock;
if clock=false then
begin
l:=0;
counter(l);
tlsStrgrd;
end;
stringgrid1.Cells[1,1]:=toString(clock);
stringgrid1.Cells[n+2,1]:=denary;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
jalan:= not jalan;
while jalan=true do begin
proses;
application.ProcessMessages;sleep(300);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
stringgrid1.ColCount:=n+3;
stringgrid1.Cells[1,0]:='clock';
stringgrid1.Cells[n+2,0]:='denary';
stringgrid1.Cells[n+2,1]:=denary;
stringgrid1.Cells[1,1]:=toString(clock);
for i:=0 to n-1 do begin
Q[i]:=false;
stringgrid1.Cells[i+2,0]:='Q'+inttostr(i);
stringgrid1.Cells[i+2,1]:=toString(Q[i]);
end;
end;
end.

Recursive Procedure on Delphi.

Yup, recursive procedure (not recursive function, 🙂 ).

I use it to create a simulation about digital asynchronous binary n-bit counter, complete with the denary representation.

n-bit means it’s very flexible, you can change n and its output (stringgrid, thats it) automatically adjust itself, 🙂

Here’s the code

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, Grids, math;

type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
BitBtn1: TBitBtn;
function denary:integer;
function tostring(a:boolean):string;
procedure counter(m:integer);
procedure proses;
procedure isiStringgrid;

procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

const n=3;
var
Form1: TForm1;
Q:array[0..(n-1)]of boolean;
clock:boolean=true;
l,denary:integer;
running:boolean=false;
implementation

{$R *.dfm}
function tform1.denary:integer;
var i,j:integer;
begin
j:=0;
for i:=0 to n-1 do begin
j:=j+round(power(2,i))*strtoint(tostring(Q[i]));
end;
denary:=j;
end;

function tform1.tostring(a:boolean):string;
begin
{}
tostring:=inttostr(-1*strtoint(booltostr(a)))
end;
procedure tform1.counter(m:integer);
begin
if l<=n-1 then begin
Q[l]:=not Q[l];
if Q[l]=false then begin
l:=l+1;
counter(l);
end;
end;
end;
procedure tform1.proses;
begin
clock:= not clock;
if clock=false then begin
l:=0;
counter(l);
isiStringgrid;
end;
stringgrid1.Cells[1,1]:=tostring(clock);
end;

procedure tform1.isiStringgrid;
var i:integer;
begin
for i:=0 to n-1 do begin
stringgrid1.Cells[2+i,1]:=tostring(Q[i]);
end;
stringgrid1.Cells[n+2,1]:=inttostr(denary);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
running:=not running;
if running=true then bitbtn1.Caption:='stop'else bitbtn1.Caption:='run';
while running=true do begin
proses;
application.ProcessMessages;sleep(500);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
stringgrid1.ColCount:=n+3;
bitbtn1.Caption:='run';
stringgrid1.Cells[1,0]:='clock';
stringgrid1.Cells[1,1]:=tostring(clock);
for i:=0 to n-1 do begin
Q[i]:=false;
stringgrid1.Cells[2+i,0]:='Q'+inttostr(i);
stringgrid1.Cells[2+i,1]:=tostring(Q[i]);
end;
stringgrid1.Cells[n+2,0]:='Denary';
stringgrid1.Cells[n+2,1]:=inttostr(denary);
end;

end.

The screenshot.

And the result, 🙂

iOS and OS X’s Note

Want to edit Pages document ‘on the fly’ but don’t have a Pages on iPhone? It’s OK.

Copy the content of your Page document by select all -> copy, then paste to Note app on OS X. Wait a moment, it will sync with the Note app on iPhone, complete with the formatting and the images, 🙂