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, :)

[Delphi] n-Order Interpolation (just for self documentation)

Of course, it can be linear, quadratic, cubic or any order interpolation

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Image1: TImage;
    Memo1: TMemo;
    procedure awal;
    procedure datamentah;
    function newton(v:real):real;
    function lagrange(v:real):real;
    procedure diferensiasi;
    procedure interpolasi;
    procedure ilagrange;
    function fx(x:real):real;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const n=11;
      orde=n;
      skalax=17;
      skalay=5;
var
  Form1: TForm1;
  x,y:array[0..n]of real;
  a,f:array[0..orde]of real;
  x0,y0:integer;
  xi,yi:real;
implementation

{$R *.dfm}

function tform1.lagrange(v:real):real;
var j,m:integer;lag,suku:real;
begin{}
  lag:=0;
  for j:=0 to orde do begin
    suku:=1;
    for m:=0 to orde do begin
      if j<> m then suku:=suku*(v-x[m])/(x[j]-x[m]);
    end;
    lag:=lag+y[j]*suku;
  end;
  lagrange:=lag;
end;

procedure tform1.ilagrange;
var i:integer;v:real;
begin{}
  image1.Canvas.Pen.Color:=clred;
  image1.Canvas.
    MoveTo(x0+round(-n*skalax),y0-round(lagrange(-n)*skalay));
  for i:=-n*100 to n*100 do begin
    v:=i/100;
    image1.Canvas.
      LineTo(x0+round(v*skalax),y0-round(lagrange(v)*skalay));
  end;
end;

procedure tform1.diferensiasi;
var i,j,k:integer;prod:real;
begin
  a[0]:=y[0];
  memo1.Lines.Append('a[0] = '+floattostr(a[0]));
  for i:=1 to orde do begin
    a[i]:=0;
    for j:=0 to i do begin
      prod:=1;
      for k:=0 to i do begin
        if (k<>j) then prod:=prod*(x[j]-x[k]);
      end;
      a[i]:=a[i]+y[j]/prod;
    end;
    memo1.Lines.Append('a['+inttostr(i)+'] = '+floattostr(a[i]));
  end;
end;

function tform1.newton(v:real):real;
var i:integer;newt,suku:real;
begin
  newt:=a[0];
  suku:=1;
  for i:=1 to orde do begin
    suku:=suku*(v-x[i-1]);
    newt:=newt+a[i]*suku;
  end;
  newton:=newt;
end;

procedure tform1.interpolasi;
var i:integer;v:real;
begin
  diferensiasi;
  {plot}
  image1.Canvas.Pen.Color:=cllime;
  image1.Canvas.
    MoveTo(x0+round(-n*skalax),y0-round(newton(-n)*skalay));
  for i:=-n*100 to n*100 do begin
    v:=i/100;
    image1.Canvas.
      LineTo(x0+round(v*skalax),y0-round(newton(v)*skalay));
  end;
end;

procedure tform1.awal;
begin
  randomize;
  image1.Width:=400;                              image1.Height:=400;
  x0:=round(image1.Width/2);                      y0:=round(image1.Height/2);
  image1.Canvas.                                  Pen.Color:=clblue;
  image1.Canvas.MoveTo(0,y0);                     image1.Canvas.LineTo(image1.Width,y0);
  image1.Canvas.MoveTo(x0,0);                     image1.Canvas.LineTo(x0,image1.Height);
  xi:=1.11;                                       memo1.Text:='';
  datamentah;                                     interpolasi;
  //ilagrange;
end;

procedure tform1.datamentah;
var i:integer;
begin
  for i:=0 to n do begin
    x[i]:=i-n/2;                                  y[i]:=fx(x[i]);
    with image1.Canvas                            do begin
      pen.Color:=clblue;                          brush.Color:=clgreen;
      pixels[x0+round(x[i]*skalax),               y0-round(y[i]*skalay)]:=clred;
      Ellipse(x0+round(x[i]*skalax)-7,            y0-round(y[i]*skalay)-7,
              x0+round(x[i]*skalax)+7,            y0-round(y[i]*skalay)+7);
    end;
  end;
end;

function tform1.fx(x:real):real;
begin
  fx:=x*x+random(20)-10;
end;

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

end.

[Delphi] Linear and Quadratic Regression (just for self documentation)

The code below have the plots and graphs (linear and quadratic regression) included

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Image1: TImage;
    Memo1: TMemo;
    procedure awal;
    procedure datamentah;
    procedure plotdata;
    procedure regresi;
    procedure kuadratis;
    procedure plotregresi;
    function f(x:real):real;
    function fk(x:real):real;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const n=40; skala=3;
var
  Form1: TForm1;
  x0,y0:integer;                              x,y:array[-n..n]of real;
  a,b:real;                                   c:array[1..3]of real;
  matrik:array[1..3,1..4]of real;
implementation

{$R *.dfm}
procedure tform1.kuadratis;
var sxi,sxi2,sxi3,sxi4,syi,syixi,syixi2:real;
i,j,k:integer;                                jml,simpan:real;
begin
sxi:=0;sxi2:=0;sxi3:=0;sxi4:=0;               syi:=0;syixi:=0;syixi2:=0;
{sigma xi} {sigma xi kuadrat}                 {sigma xi pangkat3} {sigma xi pangkat4}
{sigma yi} {sigma yi*xi}                      {sigma yi* xi*xi }
for i:=1 to n do begin
  sxi:=sxi+x[i];                              sxi2:=sxi2+x[i]*x[i];
  sxi3:=sxi3+x[i]*x[i]*x[i];                  sxi4:=sxi4+x[i]*x[i]*x[i]*x[i];
  syi:=syi+y[i];                              syixi:=syixi+y[i]*x[i];
  syixi2:=syixi2+                             y[i]*x[i]*x[i];
end;
{isi matrik}
matrik[1,1]:=n;                               matrik[1,2]:=sxi;
matrik[1,3]:=sxi2;                            matrik[1,4]:=syi;
matrik[2,1]:=sxi;                             matrik[2,2]:=sxi2;
matrik[2,3]:=sxi3;                            matrik[2,4]:=syixi;
matrik[3,1]:=sxi2;                            matrik[3,2]:=sxi3;
matrik[3,3]:=sxi4;                            matrik[3,4]:=syixi2;
{gaus naif}
for k:= 1 to 3 do begin
  for i:= k+1 to 3 do begin
    simpan:=matrik[i,k];
      if simpan=0 then begin end
        else begin
         for j:=k to 4 do
           matrik[i,j]:=
             matrik[i,j]/
              simpan*
                matrik[k,k]-
                  matrik[k,j];
                    end;
                      end;
                        end;
{subtitusi}
c[3]:=matrik[3,4]/matrik[3,3];for i:=2 downto 1 do begin jml:=0;for j:=i+1
to 3
do jml:=jml+matrik[i,j]*c[j]; c[i]:=(matrik[i,4]-jml)/matrik[i,i];end;
memo1.Lines.Append('c[1] = '+ floattostr(c[1]));
memo1.Lines.Append('c[2] = '+ floattostr(c[2]));
memo1.Lines.Append('c[3] = '+ floattostr(c[3]));
{plot kuadratis}
image1.Canvas.Pen.Color:=clred;
image1.Canvas.MoveTo(x0+round(x[-n]),y0-round(skala*fk(x[-n])));
for i:=-n to n do begin
image1.Canvas.lineto(x0+round(x[i]),y0-round(skala*fk(x[i])));
end;
end;

function tform1.fk(x:real):real;
begin
  fk:=c[1]+c[2]*x+c[3]*x*x;
end;

procedure tform1.regresi;
var i:integer;                                xix,xixx,rx,ry:real;
begin
  rx:=0;ry:=0;
  for i:=1 to n do begin
    rx:=rx+x[i];                              ry:=ry+y[i];
  end;
  rx:=rx/n;                                   ry:=ry/n;
  memo1.Lines.Append('rx = '+floattostr(rx)); memo1.Lines.Append('ry = '+floattostr(ry));
  xix:=0;                                     xixx:=0;
  for i:=1 to n do begin
    xix:=xix+(x[i]-rx)*(y[i]-ry);             xixx:=xixx+(x[i]-rx)*(x[i]-rx);
  end;
  b:=xix/xixx;                                memo1.Lines.Append('b = '+floattostr(b));
  a:=ry-b*rx;                                 memo1.Lines.Append('a = '+floattostr(a));
end;

procedure tform1.awal;
begin
  randomize;                                  memo1.Text:='';
  stringgrid1.Cells[0,0]:='x';                stringgrid1.Cells[1,0]:='y';
  stringgrid1.RowCount:=2;
  datamentah;
  plotdata;
  regresi;
  plotregresi;
  kuadratis;
end;

procedure tform1.plotregresi;
var px,py:real;
begin
  px:=-2*n;                                    py:=a+b*(-2*n);
  image1.Canvas.pen.Color:=cllime;
  image1.Canvas.MoveTo(x0+round(px),           y0-skala*round(py));
  px:=2*n;                                     py:=a+b*(2*n);
  image1.Canvas.lineTo(x0+round(px),y0-skala*  round(py));
  memo1.Lines.Append('fungsi regresi: y ='+    floattostrf(a,ffGeneral,2,4)+' + '+
  floattostrf(b,                               ffGeneral,2,4)+' x');
end;

procedure tform1.plotdata;
var i:integer;
begin
  x0:=round(image1.Width/2);                  y0:=round(image1.Height/2);
  image1.Canvas.MoveTo(0,y0);                 image1.Canvas.LineTo(image1.Width,y0);
  image1.Canvas.MoveTo(x0,0);                 image1.Canvas.LineTo(x0,image1.Height);
  for i:=-n to n do begin
    image1.Canvas.Pixels[x0+round(x[i]),y0-round(skala*y[i])]:=clblue;
  end;
end;
procedure tform1.datamentah;
var i:integer;
begin
  stringgrid1.RowCount:=2*n+1;
  for i:=-n to n do begin
    x[i]:=i;                                  y[i]:=f(x[i]);
    stringgrid1.Cells[0,i+n+1]:=floattostr(x[i]);
    stringgrid1.Cells[1,i+n+1]:=floattostr(y[i]);
  end;
end;

function tform1.f(x:real):real;
begin
  f:=x*x/32+random(20)-10;
end;

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

end.

[Delphi] Differential of Function (just for self documentation)

Here the code, it have the graph of function and plot of it diferential (gradien) line

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    procedure proses;
    procedure awal;
    function f(x:real):real;
    function df(x:real):real;
    function fs(x,xs,ys,m:real):real;
    procedure gambar;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  dx:real=0.01;
  x0,y0:integer;
implementation

{$R *.dfm}

procedure tform1.awal;
begin
  {gambar sumbu}
  x0:=round(image1.Width/2);
  y0:=round(image1.Height/2);
  with image1.Canvas do begin
    moveto(0,y0);
    lineto(image1.Width,y0);
    moveto(x0,0);
    lineto(x0,image1.Height);
  end;
end;
function tform1.f(x:real):real;
begin
  f:=10*cos(x)+x;
end;
function tform1.df(x:real):real;
begin
  df:=(f(x+dx)-f(x))/dx;
end;
function tform1.fs(x,xs,ys,m:real):real;
var c:real;
begin
  c:=ys-m*xs;
  fs:=m*x+c;
end;

procedure tform1.gambar;
var i:integer;
x,y,x1,y1,m:real;
begin
//  image1.Canvas.TextOut(0,0,'f(x)=x^2-2x-8 memiliki gradien '+floattostrf(df(0),ffnumber,8,2)+' di x=0');
  image1.Canvas.TextOut(0,0,'f(x)=x^2-2x-8 memiliki gradien '+format('%8.2f',[df(0)])+' di x=0');
  with image1.Canvas do begin
    {gambar fungsi}
    for i:=-200 to 200 do begin
      x:=i/8;
      y:=f(x);
      x1:=(i+1)/8;
      y1:=f(x1);
      pen.Color:=clblue;
      moveto(x0+i,y0-round(y));
      lineto(x0+i+1,y0-round(y1));
    end;
    {gambar garis singgung}
    m:=df(0);
    for i:=-200 to 200 do begin
      x:=i/8;
      y:=fs(x,0,f(0),m);
      x1:=(i+1)/8;
      y1:=fs(x1,0,f(0),m);
      pen.Color:=cllime;
      moveto(x0+i,y0-round(y));
      lineto(x0+i+1,y0-round(y1));
    end;
  end;
end;
procedure tform1.proses;
begin
  awal;
  gambar;
end;

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

end.

[Delphi] Gauss Naif Method (just for self documentation)

Here the code

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    StringGrid1: TStringGrid;
    StringGrid2: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
const n=3;
var
  Form1: TForm1;
  a:array[1..n,1..n+1]of real;
  x:array[1..n]of real;
  kotak:array[1..n] of tedit;
  implementation

{$R *.dfm}

procedure bacamatrik;
var i,j:integer;
begin
  for i:=1 to n do begin
   for j:=1 to n+1 do begin
     a[i,j]:=strtofloat(form1.StringGrid1.Cells[j-1,i-1]);
  end;end;
end;

procedure tulismatrik;
var i,j:integer;
begin
  for i:=1 to n do begin
   for j:=1 to n+1 do begin
     form1.StringGrid2.Cells[j-1,i-1]:=floattostr(a[i,j]);
  end;end;
end;

procedure naif;
var i,j,k:integer;
simpan:real;
begin
  for k:= 1 to n do begin
    for i:= k+1 to n do begin
       simpan:=a[i,k];
       if simpan=0 then begin
       end else begin
         for j:=k to n+1 do a[i,j]:=a[i,j]/simpan*a[k,k]-a[k,j];
       end;
    end;
  end;
end;
procedure subtitusi;
var i,j:integer;
jml:real;
begin
  x[n]:=a[n,n+1]/a[n,n];
  for i:=n-1 downto 1 do begin
    jml:=0;
    for j:=i+1 to n do jml:= jml+a[i,j]*x[j];
    x[i]:=(a[i,n+1]-jml)/a[i,i];
  end;
end;
procedure buatedit;
var i:integer;
begin
  for i:=1 to n do begin
    kotak[i]:=tedit.Create(form1);
    kotak[i].Left:=300;
    kotak[i].Top:=40+30*i;
    kotak[i].Parent:=form1;
  end;
end;
procedure isiedit;
var i:integer;
begin
  for i:=1 to n do kotak[i].Text:=floattostr(x[i]);
end;

procedure TForm1.FormCreate(Sender: TObject);
var i,j:integer;
begin
  randomize;
  stringgrid1.RowCount:=n;
  stringgrid2.RowCount:=n;
  stringgrid1.ColCount:=n+1;
  stringgrid2.ColCount:=n+1;
  for i:=1 to n do begin
    for j:=1 to n+1 do begin
       a[i,j]:=random(20)-10;
       stringgrid1.Cells[j-1,i-1]:=floattostr(a[i,j]);
  end;end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  bacamatrik;
  naif;
  subtitusi;
  tulismatrik;
  buatedit;
  isiedit;
end;

end.

[Delphi] Write to File (just for self documentation)

Here the code, the input method is still manual though, :)

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Button6: TButton;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Button7: TButton;
    procedure proses;
    procedure simpanfile;
    procedure simpanrecord;
    procedure bacarecord;
    procedure simpan;
    procedure tampilkan;
    procedure awal;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button7Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type
  tmahasiswa = record
    nama,nim,alamat,offering,nhuruf:string[30];
    umur:integer;
    nilai:real;
  end;
var
  Form1: TForm1;
  fileku:textfile;
  files: file of tmahasiswa;
  mahasiswa: tmahasiswa;
implementation

{$R *.dfm}
procedure tform1.awal;
begin
  edit1.Text:='Nama';
  edit2.Text:='NIM';
  edit3.Text:='18';{umur}
  edit4.Text:='Alamat';
  edit5.Text:='Offering';
  edit6.Text:='81';{nilai}
  edit7.Text:='Nilai Huruf';

  button6.Caption:='Simpan';
  button7.Caption:='Tampilkan';
end;
procedure tform1.simpan;
begin
  assignfile(files,'data.mp4');
  reset(files);
  mahasiswa.nama:=edit1.Text;
  mahasiswa.nim:=edit2.Text;
  mahasiswa.umur:=strtoint(edit3.Text);
  mahasiswa.alamat:=edit4.Text;
  mahasiswa.offering:=edit5.Text;
  mahasiswa.nilai:=strtofloat(edit6.Text);
  mahasiswa.nhuruf:=edit7.Text;

  seek(files,filesize(files));
  write(files,mahasiswa);
  closefile(files);
end;
procedure tform1.tampilkan;
begin memo1.Text:='';bacarecord;end;
procedure TForm1.Button6Click(Sender: TObject);
begin simpan; end;
procedure TForm1.Button7Click(Sender: TObject);
begin tampilkan;end;

procedure tform1.bacarecord;
var text:string;
begin
  assignfile(files,'data.mp4');
  //filemode:=fmopenread;
  reset(files);
  while not eof(files) do begin
    read(files,mahasiswa);
    text:=mahasiswa.nama+' ('+inttostr(mahasiswa.umur)+') '+mahasiswa.nim+' '+mahasiswa.alamat+' '+mahasiswa.offering+' '+floattostr(mahasiswa.nilai)+' ('+mahasiswa.nhuruf+')';
    memo1.Lines.Append(text);
  end;

  closefile(files);

end;
procedure tform1.simpanrecord;
begin
  assignfile(files,'data.mp4');
  rewrite(files);

  mahasiswa.nama:='string';
  mahasiswa.nim:='001';
  mahasiswa.alamat:='malang';
  mahasiswa.offering:='abc';
  mahasiswa.nhuruf:='wow+';
  mahasiswa.umur:=20;
  mahasiswa.nilai:=60;
  write(files,mahasiswa);

  mahasiswa.nama:='qwerty';
  mahasiswa.nim:='002';
  mahasiswa.alamat:='malang';
  mahasiswa.offering:='abc';
  mahasiswa.nhuruf:='wow';
  mahasiswa.umur:=22;
  mahasiswa.nilai:=55;
  write(files,mahasiswa);

  mahasiswa.alamat:='tidak di malang';
  mahasiswa.offering:='abc';
  mahasiswa.nhuruf:='wow-';
  mahasiswa.umur:=18;
  mahasiswa.nilai:=55;
  write(files,mahasiswa);

  mahasiswa.nama:='dvorak';
  mahasiswa.nim:='004';
  mahasiswa.alamat:='batu';
  mahasiswa.offering:='nyasar';
  write(files,mahasiswa);

  closefile(files);

end;
procedure tform1.simpanfile;
var i:integer;
begin
  assignfile(fileku,'filesaya.txt');
  rewrite(fileku);

  write(fileku,'Hello ');
  write(fileku,'world');

  writeln(fileku);
  for i:=1 to 10 do begin
    write(fileku, i/2, ' ' );
    //writeln(fileku);
  end;

  writeln(fileku);

  for i:=1 to 10 do begin
    write(fileku, i/2:5:1, ' ' );
    //writeln(fileku);
  end;


  closefile(fileku);


end;

procedure tform1.proses;
var i:integer;
begin
  memo1.Text:='';
  for i:=1 to 10 do begin
    memo1.Lines.Append('OK, ini adalah baris ke-'+inttostr(i));
  end;
  memo1.Lines.Strings[5-1]:='dengan';
  {}
end;

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

procedure TForm1.Button2Click(Sender: TObject);
begin
  simpanfile;
end;

procedure TForm1.Button3Click(Sender: TObject);
var text:string;
begin
  assignfile(fileku,'filesaya.txt');
  reset(fileku);
  while not eof(fileku) do begin
    readln(fileku,text);
    memo1.Lines.Append(text);
  end;
  closefile(fileku);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  simpanrecord;

end;

procedure TForm1.Button5Click(Sender: TObject);
begin
   bacarecord;
end;


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

end.

<\pre>

[Delphi] Newton Method for Find a Root of a Function (just for self documentation)

Tadaa...

It's my Newton code in Delphi to find a root

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function fungsi(x:real):real;
begin fungsi:=x*x-3*x-4;end;
function turunan(x:real):real;
begin turunan:=2*x-3;end;
procedure newton;
var y1,ty1,x1,err:real;
n:integer;
ketemu:boolean;
begin
  n:=0;err:=0.01;ketemu:=false;
  x1:=strtofloat(form1.Edit1.Text);
  while ketemu=false do begin
   y1:=fungsi(x1);
   ty1:=turunan(x1);
   if y1=0 then begin
     form1.Edit2.Text:='akarnya adalah '+ floattostr(x1);
     ketemu:=true;end;
   if abs(y1)<=err then begin
     form1.Edit2.Text:='akarnya adalah '+ floattostr(x1);
     ketemu:=true;end;
   x1:= x1-(y1/ty1);n:=n+1;
   form1.Edit3.Text:='langkah ke ' + inttostr(n);
   application.ProcessMessages;sleep(100);
  end;
end;
procedure gambar;
var x0,y0,y1,i:integer;
begin
  x0:=round(form1.Image1.Width/2);
  y0:=round(form1.Image1.Height/2);
  with form1.Image1.canvas do begin
    pen.Color:=clred;
    moveto(0,y0);lineto(form1.Image1.Width,y0);
    moveto(x0,0);lineto(x0,form1.Image1.Height);
  end;
  for i:=-100 to 150 do begin
    y1:=round(fungsi(i/8));
    form1.Image1.Canvas.Pixels[x0+i,y0-y1]:=clblue;
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  gambar;
  newton;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   button1.Caption:='newton';
   edit1.Text:='0';

end;

end.

Array di Delphi

Array dapat digunakan sebagai penyimpanan sementara. Array dapat dipandang sebagai sebuah variabel yang berisi barisan variabel di dalamnya.

Berikut adalah contoh penggunaan array di delphi sekaligus penggunaan listbox dan radiobutton.



Buat sebuah form dengan satu edit, satu button, satut listbox dan tiga radiobutton.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    ListBox1: TListBox;
    RadioButton3: TRadioButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  nama:array [0..100] of string;
  n:integer;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  radiobutton1.Caption:='input';
  radiobutton2.Caption:='tampilkan';
  radiobutton3.Caption:='semua';
  edit1.Text:='';
  radiobutton1.Checked:=true;
  button1.Caption:='OK';
  n:=0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
    if (radiobutton1.Checked=true) and not(edit1.Text='') then begin
      listbox1.Items.add(edit1.Text);
      n:=n+1;
      nama[n]:=edit1.Text;
    end;
    if radiobutton2.Checked=true then begin
      listbox1.Clear;
      if (edit1.Text<='9') and (edit1.Text>='0') and not(edit1.Text='') then begin
        listbox1.Items.Add(nama[strtoint(edit1.Text)]);
      end;
    end;
    if radiobutton3.Checked=true then begin
      listbox1.Clear;
      for i:=1 to n do begin
        listbox1.Items.Append(nama[i]);
      end;
    end;
end;

end.

Record di Delphi

Record dapat dikatakan sebagai sebuah obyek di Delphi, semacam variabel yang memiliki variabel. Seperti Button yang memiliki caption atau edit yang memiliki text, kita dapat membuat sebuah obyek yang memiliki variabel sendiri.


Berikut adalah contoh program menggerakkan sebuah kotak (menggunakan shape). Kita membuat record baru bernama tkotak yang memiliki variabel x, y, vx, vy, ax, ay. Variabel kotak merujuk pada record tkotak.


Tombol jika diklik akan menjalankan perintah pada prosedur proses. Prosedur proses adalah metode Euler untuk mengupdate posisi dan kecepatan kotak berdasarkan posisi dan kecepatan awal.

Kode lengkapnya adalah sebagai berikut

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Shape1: TShape;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type
  tkotak=record
  x,y,vx,vy,ax,ay:real;
  end;
var
  Form1: TForm1;
  jalan:boolean;
  kotak:tkotak;
  dt:real;

implementation

{$R *.dfm}
procedure proses;
begin
  kotak.vx:=kotak.vx+kotak.ax*dt;
  kotak.x:=kotak.x+kotak.vx*dt;
  form1.Shape1.Left:=round(kotak.x);

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  button1.Caption:='jalan';
  jalan:=false;
  kotak.x:=0;
  kotak.y:=0;
  kotak.vx:=5;
  kotak.vy:=0;
  kotak.ax:=10;
  kotak.ay:=0;
  dt:=0.1;
  shape1.Left:=round(kotak.x);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  jalan:=not(jalan);
  if jalan=true then button1.Caption:='stop' else button1.Caption:='jalan';
  while jalan=true do begin
    proses;
    application.ProcessMessages;
    sleep(100);
  end;
end;

end.

Toggle di Delphi

Toggle adalah sebuah tombol dengan sifat jika saat itu on maka jika ditekan akan off jika ditekan lagi on jika ditekan lagi akan off dan seterusnya.

Di Delphi kita dapat membuat tombol jenis ini.

Buat sebuah aplikasi baru, letakkan sebuah tombol di form. Berikut adalah perintah lengkapnya.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  jalan:boolean;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  jalan:=not(jalan);
  if jalan=true then button1.Caption:='stop' else button1.Caption:='jalan';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  jalan:=false;
end;

end.

Shape di Delphi

Shape adalah sebuah object berupa bentuk-bentuk dasar di Delphi.

Di Delphi ada beberapa cara untuk menggambar; diantaranya menggunakan Shape. Cara lain menggunakan canvas dengan perintah moveto+lineto+fill. Meskipun cara terakhir menawarkan felkesibilitas bentuk yang tinggi, mereka tidak dapat digerakkan dengan mudah; kita harus menghapus dan membuat lagi dari awal.



Shape dapat dengan mudah digerakkan karena memiliki properties top dan left. Berikut adalah cara menggerakkan sebuah Shape dengan fitur kecepatan dan percepatan serta sebuah tombol toggle jalan/stop.

Buat aplikasi baru, letakkan dua edit, satu shape dan satu button.

Berikut adalah perintah lengkapnya.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Shape1: TShape;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  jalan:boolean;
  ax,vx,xx,dt:real;
implementation

{$R *.dfm}

procedure proses;
begin
  xx:=xx+vx*dt;
  vx:=vx+ax*dt;
  with form1 do begin
    edit2.Text:=floattostr(vx);
    shape1.Left:=round(xx);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  jalan:=false;
  edit1.Text:='0';
  edit2.Text:='1';
  dt:=0.1;
  button1.Caption:='jalan';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  jalan:=not(jalan);
  ax:=strtofloat(edit1.Text);
  vx:=strtofloat(edit2.Text);
  xx:=shape1.left;
  if jalan=true then button1.Caption:='stop' else button1.Caption:='jalan';
  while jalan=true do begin
    proses;
    application.ProcessMessages;
    sleep(100);
  end;
end;

end.

Stringgrid di Delphi

Buat aplikasi baru
Letakkan sebuah tombol, edit dan stringgrid di form
Kosongkan bagian text pada edit1
Ubah caption pada button1 menjadi input
Pada properties stringgrid1, ubah colcount->7 kemudian rowcount -> 17
Dobelklik form1, ketikkan perintah berikut

  stringgrid1.Cells[0,0]:='No';
  stringgrid1.Cells[1,0]:='Nama';
  stringgrid1.Cells[2,0]:='U1';
  stringgrid1.Cells[3,0]:='U2';
  stringgrid1.Cells[4,0]:='U3';
  stringgrid1.Cells[5,0]:='U4';
  stringgrid1.Cells[6,0]:='Nil'; 

Jalankan program. Kini stringgrid1 memiliki judul pada baris pertama tiap kolom.



Untuk mengisi kolom nama pada stringgrid, kita gunakan tombol input.
Agar dapat otomatis berganti baris kita perlu membuat sebuah variabel global n bertipe integer.
Dobelklik tombol input, ketikkan perintah berikut

  stringgrid1.Cells[1,n]:=edit1.Text;
  stringgrid1.Cells[0,n]:=inttostr(n);
  n:=n+1;

Jalankan program. Ketikkan sebarang nama di edit1, kemudian klik tombol input, lakukan berulang-ulang.

Loop di Delphi

Buat aplikasi baru

Tempatkan sebuah edit dan dua buah tombol, isi edit dengan nilai nol, ganti caption tombol masing-masing “Jalan” dan “Stop”

Buat variabel global “jalan” berjenis boolean

Dobelklik tombol “Jalan”, ketikkan perintah sebagai berikut



jalan:=true;
x:=strtoint(edit1.Text);
while jalan=true do begin
x:=x+1;
edit1.Text:=inttostr(x);
application.ProcessMessages;
sleep(1000);
end;

(jangan lupa membuat variabel lokal “x” berjenis integer sebelum begin)

Dobelklik tombol “Stop”, ketikkan perintah sebagai berikut

jalan:=false
jalankan program. Jika gagal, ubah deklarasi x dari x:int; menjadi x:integer;

Radiobutton di Delphi

Buat aplikasi baru

Tempatkan 2 buah edit, dua buah label, empat radiobutton dan satu tombol pada form

Ubah sedemikian rupa sehingga menjadi seperti gambar kedua

Dobelklik tombol “Hitung”, isi dengan perintah berikut



if radiobutton1.Checked=true then begin
edit3.Text:=inttostr(strtoint(edit1.Text)+strtoint(edit2.Text));
end else if radiobutton2.Checked=true then begin
edit3.Text:=inttostr(strtoint(edit1.Text)-strtoint(edit2.Text));
end else if radiobutton3.Checked=true then begin
edit3.Text:=inttostr(strtoint(edit1.Text)*strtoint(edit2.Text));
end else if radiobutton4.Checked=true then begin
edit3.Text:=floattostr(strtoint(edit1.Text)/strtoint(edit2.Text));
end;

jalankan program

sebagai pelengkap, tambahkan perintah pada radiobutton sedemikian sehingga jika kita memilih “Pengurangan”, maka otomatis label1 menjadi “-”

Berkenalan dengan Delphi

Perkenalan dengan Delphi

Buat aplikasi baru

Buat sebuah label di dalam form, pada caption di properties, ubah tulisan “label1” menjadi “Hello World”


Buat satu tombol di dalam form, pada caption di properties ubah “button1”menjadi “Halo Dunia”




Dobel klik tombol “Halo Dunia”, tuliskan perintah berikut untuk mengubah tulisan “Hello World” menjadi “Halo Dunia”
form1.Label1.Caption:='Halo Dunia';


Jalankan program dengan menu Run->Run atau tombol F9


Ketikkan perintah berikut untuk mengubah warna font pada label 1
form1.Label1.Font.Color:=cllime;


Ketikkan perintah berikut untuk mengubah warna background pada label
form1.Label1.Color:=clred;


cllime, clred adalah warna-warna yang dikenali oleh Delphi. Warna-warna yang lain dapat dilihat di bagian properties


Buat tiga edit dan sebuah tombol

di properties bagian text pada masing-masing edit, ganti dengan angka nol
ganti caption pada tombol dengan “Hitung”

Dobelklik tombol “Hitung” dan ketikkan perintah berikut
edit3.Text:=edit1.Text+edit2.Text;

Jalankan program, klik tombol “Hitung”, apa yang terjadi? Ubah angka-angka pada kotak input (edit1 dan edit2) kemudian klik tombol hitung, apa yang terjadi?

Angka yang ada pada edit diperlakukan sebagai string (huruf) oleh Delphi sehingga jika kita menambahkan angka pada edit1 dengan angka pada edit2, maka mereka tidak menjumlahkan angka melainkan menambahkan angka edit2 di samping edit1.

Agar angka pada edit1 diperlakukan sebagai angka, maka harus kita konversi dengan perintah strtoint(edit1)

Namun karena hasil penjumlahan antara strtoint(edit1)+strtoint(edit2) adalah angka, kita tidak dapat memasukkannya ke edit3; kita harus mengkonversi kembali menjadi string sehingga perintah lengkapnya adalah
edit3.Text:= inttostr(strtoint(edit1)+strtoint(edit2));

jalankan program untuk melihat bedanya

Creating Tree with delphi

Now, I liked to explain how to do that, but firstly you have to open your Delphi.

Image below is result of code.


The code itself is like here
==================================
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
StringGrid1: TStringGrid;
BitBtn1: TBitBtn;
DrawGrid1: TDrawGrid;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
kotak: array[0..100,0..100]of integer;
node: array[0..100,0..100]of integer;
cabang: array[0..100,0..100]of integer;
anak: array[0..100,0..100]of integer;
jalan:boolean;
kemungkinan:integer;
implementation

{$R *.dfm}
procedure awal;
var i,j:integer;
begin
jalan:=false;
for i:=0 to 19 do begin
for j:=0 to 19 do begin
kotak[i,j]:=0;
node[i,j]:=random(kemungkinan);
anak[i,j]:=0;
form1.StringGrid1.Cells[j,i]:=inttostr(kotak[j,i]);
cabang[i,j]:=0;
//form1.DrawGrid1.Brush.Color:=clgreen;
form1.DrawGrid1.Canvas.Brush.Color:=claqua;
form1.DrawGrid1.Canvas.FillRect(form1.DrawGrid1.CellRect(i,j));
end;end;
cabang[9,19]:=1;
node[9,19]:=1;
anak[9,19]:=1;
kotak[9,19]:=1;
form1.DrawGrid1.Canvas.Brush.Color:=clgreen;
form1.DrawGrid1.Canvas.FillRect(form1.DrawGrid1.CellRect(9,19));
end;
procedure proses;
var i,j,k:integer;
begin
for i:=1 to 19 do begin
for j:=1 to 19 do begin
if cabang[i,j]=1 then begin
if node[i,j]>0 then begin
if random(kemungkinan)>0 then begin
kotak[i-1,j-1]:=1;cabang[i-1,j-1]:=1;anak[i-1,j-1]:=1;end;
//if random(2)=1 then begin
//kotak[i,j-1]:=1;cabang[i,j-1]:=1;anak[i,j-1]:=1;end;
if random(kemungkinan)>0 then begin
kotak[i+1,j-1]:=1;cabang[i+1,j-1]:=1;anak[i+1,j-1]:=1;end;
end;{node}
cabang[i,j]:=0;
end;{cabang}
if cabang[i,j]=0 then kotak[i,j]:=0;
if anak[i,j]=1 then kotak[i,j]:=1;
form1.StringGrid1.Cells[j,i]:=inttostr(kotak[j,i]);
{warna}
if kotak[i,j]=1 then begin
form1.DrawGrid1.Canvas.Brush.Color:=clgreen;
form1.DrawGrid1.Canvas.FillRect(form1.DrawGrid1.CellRect(i,j));
end;
if kotak[i,j]=0 then begin
form1.DrawGrid1.Canvas.Brush.Color:=claqua;
form1.DrawGrid1.Canvas.FillRect(form1.DrawGrid1.CellRect(i,j));
end;
end;end;{for}
for i:=1 to 19 do begin
for j:=1 to 19 do begin
form1.DrawGrid1.Canvas.Brush.Color:=clwhite;
if kotak[i,j]=1 then begin
for k:=j+1 to 19 do begin
if kotak[i,k]=0 then form1.DrawGrid1.Canvas.FillRect(form1.DrawGrid1.CellRect(i,k));
end;{for}
end;{if}
end;end;{for}
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
awal;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
jalan:=true;
while jalan=true do begin
proses;
application.ProcessMessages;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
randomize;
jalan:=false;
kemungkinan:=4;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
jalan:=false;
application.Terminate;
end;

end.
========================================
here is another image result, remember to always using randomize or your tree will always has same form in sequence.

Problem with Checkbox

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
m,n:integer;

implementation

{$R *.dfm}
procedure lingkaran;
begin
form1.Image1.Canvas.Brush.Color:=clwhite;
form1.Image1.Canvas.Ellipse(m-77,n-77,m+77,n+77);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
m:=75;
n:=57;
//buat kotak putih//
form1.Image1.Canvas.Brush.Color:=clwhite;
form1.Image1.Canvas.Rectangle(0,0,form1.Image1.Width,form1.Image1.Height);
//buat pohon//
//buat lingkaran//
if form1.CheckBox1.Checked=true then begin
lingkaran;
end;
form1.Image1.Canvas.Brush.Color:=clblue;
form1.Image1.Canvas.Ellipse(m-7,n-7,m+7,n+7);
end;


end.