Create Res2DMod File from Delphi

I post the full source code below

 

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit8: TEdit;
    Edit9: TEdit;
    Edit10: TEdit;
    Edit11: TEdit;
    Edit12: TEdit;
    Edit13: TEdit;
    Edit14: TEdit;
    Edit15: TEdit;
    Edit16: TEdit;
    Edit17: TEdit;
    Button1: TButton;
    StringGrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var i,j:integer;
begin
  edit1.Text:='Fault Model';
  edit2.Text:='51';
  edit3.Text:='15';
  edit4.Text:='0';
  edit5.Text:='1.0';
  edit6.Text:='2';
  edit7.Text:='0,200,3';
  edit8.Text:='4';
  edit9.Text:='200.0, 350.0, 175.0';
  edit10.Text:='14';
  edit11.Text:='0.2500, 0.5000, 0.7125, 1.1875, 1.6875, 2.3125,'+
                '3.1875, 4.4375, 6.4375, 10.4375, 18.4375, 34.4375,'+
                '66.4375, 130.4375 ';
  edit12.Text:='3';
  edit13.Text:='0';
  edit14.Text:='0';
  edit15.Text:='0';
  edit16.Text:='0';
  edit17.Text:='0';
  for i:=0 to 13 do begin
    for j:=0 to 209 do begin
      stringgrid1.Cells[j,i]:='0';
    end;
  end;
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
  if stringgrid1.Cells[ACol,Arow]='0' then
    stringgrid1.Cells[ACol,Arow]:='1' else
      stringgrid1.Cells[ACol,Arow]:='0';
end;

procedure TForm1.Button1Click(Sender: TObject);
var f:textfile;
    s:string;
    i,j:integer;
begin
  assignfile(f,'data.mod');
  rewrite(f);
  writeln(f,edit1.text);
  writeln(f,edit2.text);
  writeln(f,edit3.text);
  writeln(f,edit4.text);
  writeln(f,edit5.text);
  writeln(f,edit6.text);
  writeln(f,edit7.text);
  writeln(f,edit8.text);
  writeln(f,edit9.text);
  writeln(f,edit10.text);
  writeln(f,edit11.text);
  for i:=0 to 13 do begin
    s:='';
    for j:=0 to 209 do begin
      s:=s+stringgrid1.Cells[j,i];
    end;
    writeln(f,s);
  end;
  writeln(f,edit12.text);
  writeln(f,edit13.text);
  writeln(f,edit14.text);
  writeln(f,edit15.text);
  writeln(f,edit16.text);
  writeln(f,edit17.text);

  closefile(f);
end;

end.

.

Parsing a String to Get a certain Substring (Serial Number, Product Keys, etc)

I have a question from a new friend on my instagram

Basically, he needs only certain substring.

Here's my code to parse the string.

 

The main code is

s          := edit1.text;

p          := pos('ME',s);

edit2.text := copy(s,p+2,13);

.

Playing with Memo in Delphi

I change the font in memo (tMemo) into courier. With this change, it's easy to do string manipulation with old Pascal style.

Below, I create small program with read input from edit into n variable. The input can only contain number 1 to 9.

The output is displayed on Memo. It's just number 123456789 (yeah, it has type string, but its number).

It's that all? No. The number's forming a 'cross' centered on number specified in edit. :)

Palindrom Checker

This simple program is using an edit as input, a button to trigger processing and a memo for output.

I used edit.text as s value and then reverse its value using for command and saved to rs variable.

We compared s and rs to determine that s is palindrom or not.



Here's the code

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure tform1.proses;
var s,rs:string;
  i:integer;
  palindrom:boolean;
begin
  memo1.Text:='';
  palindrom:=true;
  s:=edit1.Text;
  for i:=length(s) downto 1 do begin
    rs:=rs+s[i];
  end;
  for i:=1 to length(s) do begin
    if s[i]<>rs[i] then begin
      palindrom:=false;
      break;
    end;
  end;
  memo1.Lines.Append(s);
  memo1.Lines.Append(rs);
  if palindrom=true then
    memo1.Lines.Append('is palindrom')
      else
        memo1.Lines.Append('is not palindrom');

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  memo1.Text:='';
end;

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

end.

.

Walking Star in Delphi's Stringgrid.

This code moves the star from cell to cell on string grid.

I use variable s, an array of string type variable.

For delay, or controlling the speed, I use application.processmessages and sleep() combo command.

This code fills cell with blank (space) value that corresponds with s, except one cell. This one cell then "moves" to the right, into the cell next to it.

For this purpose I declare two integer type variable, sx and sy. This variable add itself by one every step. Based on this two variable, the cell that should be filled with star is decided.

Digit Word.

A digit word is a word where, after possibly removing some letters, you are left with one of the single digits:
ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT or NINE.
For example:
• BOUNCE and ANNOUNCE are digit words, since they contain the digit ONE.
• ENCODE is not a digit word, even though it contains an O, N and E, since they are not in order.
 

Here's my code on Delphi

unit Unit1;

interface

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

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

var
  Form1: TForm1;
  digit,cdigit:array[1..9] of string;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  memo1.Text:='';
  digit[1]:='one';
  digit[2]:='two';
  digit[3]:='three';
  digit[4]:='four';
  digit[5]:='five';
  digit[6]:='six';
  digit[7]:='seven';
  digit[8]:='eight';
  digit[9]:='nine';
end;

procedure tform1.proses;
var s:string;
    i,j,k,n:integer;
    c:array[1..9]of integer;
    ck:array[1..9]of boolean;
begin
  memo1.Text:='';
  s:=edit1.Text;
  memo1.Lines.Append(s);
  memo1.Lines.Append('');
  n:=length(s);
  for i:=1 to 9 do begin
    cdigit[i]:='';
    c[i]:=1;
    ck[i]:=true;
  end;

  //looking for char
  for i:=1 to 9 do begin
    for j:=1 to length(digit[i]) do begin
      if ck[i]=true then begin
       ck[i]:=false;
       for k:=c[i] to n  do begin
        if s[k]=digit[i][j] then begin
          ck[i]:=true;
          cdigit[i]:=cdigit[i]+s[k];
          c[i]:=c[i]+1;
          break;
        end;
       end;
      end;
    end;
  end;
  //compare
  for i:=1 to 9 do begin
    memo1.Lines.Append(cdigit[i]);
  end;

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

end.

.

"Auto" Gauss Naif in Delphi.

After do this in Python, now it's time to bring it back to Delphi, where all of this is started, :)


The heart of code lay on this one

procedure tform1.gauss;
var i,j,k:integer; temp:real;
begin
  for i:=1 to 9 do begin
    for j:= 1 to i do begin
      if t[i,j]<>0 then begin
        temp:=t[i,j];
        for k:= 1 to 10 do begin
          if i=j then
            t[j,k]:=t[j,k]/temp
              else t[i,k]:=t[i,k]/temp - t[j,k];
        end;
      end;
    end;
  end;
  //back subtitution
  for i:=9 downto 1 do begin
    x[i]:=t[i,10];
    for j:=9  downto i do begin
      if i<>j then
        x[i]:=x[i]-x[j]*t[i,j];
    end;
  end;

You could say that it consists of zeroing lower tringle and normalizing the diagonal and then subtituting the value.

There's little failsafe code here, that is if we already have zero cell, don't proceed, or it will gave divided by zero error.

Manual Gauss Elimination on 3x3 Matrices in Delphi

I use this code in order to find its pattern.

Yes, there is many Gauss code out there. I plan to write it on next post about it. The dynamic Gauss Elimination code that could be implemented to any size of matrices.

But for now, let just settle on this.

https://youtu.be/csiFpdsrzzQ

Flappy Bird Like in Delphi

Remember the infamous Flappy Bird? Yup, I will create the program based on that algorithm.

Newton Polinomial.

Here's code for Newton's divided differences interpolation polynomial (quite mouthful huh, :) ).

The purpose of this method is to create a function (polynomial) that passes through given set of data points.




I read data point from several edit box.

procedure TForm1.Button3Click(Sender: TObject);
var i:integer;
begin
  for i:=0 to n do begin
    x[i]:=strToFloat(kx[i].Text);
    y[i]:=strToFloat(ky[i].Text);
  end;
  xc:=strToFloat(kxc.Text);
  yc:=fn(xc);
  kyc.Text:=floatToStr(yc);
  gambarNewton;
end;

.
kx and ky is tEdit created when button1 is clicked

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
  button2.Enabled:=true;
  button3.Enabled:=true;
  button4.Enabled:=true;
  button5.Enabled:=true;

  n:=strToInt(edit1.Text);
  kxc:=tEdit.Create(form1);       kyc:=tEdit.Create(form1);
  kxc.Parent:=form1;              kyc.Parent:=form1;
  kxc.Left:=36;                   kyc.Left:=72;
  kxc.Width:=36;                  kyc.Width:=36;
  kxc.Text:='0,5';

  for i:=0 to n do begin
    kx[i]:=tEdit.Create(form1);     ky[i]:=tEdit.Create(form1);
    kx[i].Parent:=form1;            ky[i].Parent:=form1;
    kx[i].Top:=36+36*i;             ky[i].Top:=36+36*i;
    kx[i].Left:=36;                 ky[i].Left:=72;
    kx[i].Width:=36;                ky[i].Width:=36;
    kx[i].Text:=intToStr(i);        ky[i].Text:=intToStr(i);
  end;
end;

xc is x coordinate where the corresponding y (yc) is obtained using Newton method by calling it

yc=fn(xc)

function tform1.fn(xs:real):real;
var i:integer;fs:real;
begin
  fs:=0;
  for i:=0 to n do begin
    fs:=fs+b(i,0)*c(xs,i);
  end;
  fn:=fs;
end;

the fn function call the two other function. The b function, a recursive contain divided difference like this

function tform1.b(i,j:integer):real;
begin
  if i=0 then b:=y[0]
    else if (i-j)=1 then
      b:=(y[i]-y[j])/(x[i]-x[j])
        else
          b:=(b(i,j+1)-b(i-1,j))/(x[i]-x[j]);
end;

and c function, a recursive function (or you could rewrite it using simple for command)

function tform1.c(xs:real;i:integer):real;
begin
  if i=0 then c:=1
    else c:=(xs-x[i-1])*c(xs,i-1);
end;

and finally, draw the data and the function on image1

fprocedure tform1.gambarNewton;
var i,x0,y0:integer;px,py:real;
begin
  x0:=image1.Width div 2;               y0:=image1.Height div 2;
  image1.Canvas.Brush.Color:=clLime;
  image1.Canvas.Rectangle(0,0,image1.Width,image1.Height);
  image1.Canvas.Brush.Color:=clWhite;
  image1.Canvas.Pen.Color:=clBlack;
  image1.Canvas.MoveTo(0,y0);           image1.Canvas.LineTo(image1.Width,y0);
  image1.Canvas.MoveTo(x0,0);           image1.Canvas.LineTo(x0,image1.Height);
  for i:=-300 to 300 do begin
    px:=i/skala;                          py:=skala*fn(px);
    image1.Canvas.Pixels[x0+i,y0-round(py)]:=clGreen;
  end;
  for i:=0 to n do begin
    px:=x0+skala*x[i];                        py:=y0-skala*y[i];
    image1.Canvas.Ellipse(round(px)-7,round(py)-7,round(px)+7,round(py)+7);
  end;
  px:=x0+skala*xc;                        py:=y0-skala*yc;
  image1.Canvas.Brush.Color:=clred;
  image1.Canvas.Ellipse(round(px)-7,round(py)-7,round(px)+7,round(py)+7);
  image1.Canvas.Brush.Color:=clwhite;
end;

Short Function.

Here's my implementation of function according to The Power of 10;

"Restrict functions to a single printed page."

As bonus, I didn't use global variable if possible. So if a function or procedure need a variable from others, it have to be passed using parameter on that function.

If we look at the code below, we know that it can be rewritten using a long single procedure or function. But according The Power of Ten, a function should be as short as possible so it could be printed in a single page.

So, instead one long multiple page function, I write/break it as several short-single-printed-page functions. :)

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Edit3: TEdit;
    Edit4: TEdit;
    procedure proses;
    function konversi(a:real;c,d:char):string;
    function konversiC(a:real;d:char):string;
    function konversiF(a:real;d:char):string;
    function konversiR(a:real;d:char):string;
    function konversiK(a:real;d:char):string;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

procedure tform1.proses;
var
  a:real;
  s,b:string;
  c,d:char;
begin
  a:=strToFloat(edit1.Text);
  s:=edit2.Text;
  c:=s[1];
  s:=edit4.Text;
  d:=s[1];
  b:=konversi(a,c,d);
  edit3.Text:=b;
end;

function tform1.konversi(a:real;c,d:char):string;
begin
  case c of
    'C':konversi:=konversiC(a,d);
    'F':konversi:=konversiF(a,d)
    'R':konversi:=konversiR(a,d)
    'K':konversi:=konversiK(a,d)
    else konversi:='error';
  end;
end;

function tform1.konversiC(a:real;d:char):string;
begin
  case d of
    'C':konversiC:=floatToStr(a);
    'F':konversiC:=floatToStr(a*9/5+32);
    'R':konversiC:=floatToStr(a*4/5);
    'K':konversiC:=floatToStr(a+273);
    else konversiC:='Error';
  end;
end;

function tform1.konversiF(a:real;d:char):string;
begin
  case d of
    'C':konversiF:=floatToStr((a-32)*5/9);
    'F':konversiF:=floatToStr(a);
    'R':konversiF:=floatToStr((a-32)*4/9);
    'K':konversiF:=floatToStr((a-32)*5/9+273);
    else konversiF:='Error';
  end;
end;

function tform1.konversiR(a:real;d:char):string;
begin
  case d of
    'C':konversiR:=floatToStr(a*5/4);
    'F':konversiR:=floatToStr(a*9/4+32);
    'R':konversiR:=floatToStr(a);
    'K':konversiR:=floatToStr(a*5/4+273);
    else konversiR:='Error';
  end;
end;

function tform1.konversiK(a:real;d:char):string;
begin
  case d of
    'C':konversiK:=floatToStr(a-273);
    'F':konversiK:=floatToStr((a-273)*9/5+32);
    'R':konversiK:=floatToStr((a-273)*4/5);
    'K':konversiK:=floatToStr(a);
    else konversiK:='Error';
  end;
end;

end.

.

Create CSV file using Delphi

 I used textfile variable to write to a file (or create it if it don't exist).

 CSV file? Just make sure that the name at assignfile  command had .csv extension, :)

 Of course we have to format the output to meet the CSV standart; separated by comma.

procedure TForm1.Button1Click(Sender: TObject);
var
    fileku:textfile;
    i,j,n:integer;
begin
  n:=10;
  assignfile(fileku,'data.csv');
  rewrite(fileku);
  writeln(fileku,'tadaa...');
  for i:=1 to n do begin
    for j:=1 to n do begin
      writeln(fileku,i,',',j,',','data',i,j);
    end;
  end;
  closefile(fileku);
end;

.

Delphi on OS X

 Here's the WineSkin version.

 I found it's way smoother than WineBottler version, ...., but hard to figure how to use it

 To install Delphi in OS X using WineSkin, we have to download and install Wineskin, of course, :)

• Open Wineskin Winery.app
• Make sure you have a Wrapper version and an Engine
• Select the Engine you want to use (I use WS9Wine1.7.52)
• Press the Create Wrapper button
• Enter in the name Delphi (or whatever you have in mind) for the wrapper and press OK
• When its done being created, click the button to view it in Finder in the finished window
• Close Wineskin Winery.app.
• Right click Delphi.app in Finder and select “Show Package Contents”
• Double click and run Wineskin.app.
• Now click on the Install Software button
• Select to choose a setup executable
• Navigate to the Delphi setup exe file you downloaded in step one
• Select the setup exe file and press the choose button
• At this point Delphi setup should begin, go through the Delphi setup like a normal install
• After the setup is done, back in Wineskin.app, it should pop up asking you to select the .exe file
• Choose the delphi32.exe file in the drop down list and press the Select Button
• Now press the Quit button to exit Wineskin.app
• Back in Finder, double click Delphi.app and start coding

 It has the same problem with WineBottler,  the toolbar tab's seem order by itself alphabetically, so the default toolbar tab is not ' standard ' tab but 'additional' one

code
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=false;

implementation

{$R *.dfm}

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

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 button1.Caption:='Run';
end;

end.

.

Delphi on OS X

 I use WineBottler to install Delphi 7 on my El Capitan.

 It's installed, it can run.

 The one that tickle me is the toolbar list is scrambled, it's sorted alphabetically, so additional toolbar is in the first and act as default toolbar.

code

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.

Playing (again) with 'Home Made' Vector in Delphi

Here it is. I create a vector as new type, which is in itself is three dimension array.

Then I declared u as vector with three dimension;
u (h,i,j)

where h = 0, 1, 2  as physical component (eg: height, velocity, momentum)
i , j = 0, 1, 2, ..., n as row n column


So if we read u[0,1,1], it means height value at coordinate (1,1); u[1,1,1] is the velocity value; [2,1,1] is the momentum value at the same coordinate.


Trying some of properties of it. I found out that we can initialize all component of vector-u with this one line code

u:=fu(h[i,j],i,j);

so the component u(h,i,j) will filled. Notice that the function has vector (or in this case array) return value.



The code below show how I fill the value of component u(0, i, j)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
const n=3;
type vector=array[0..2,0..n,0..n]of real;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    function fu(a:real;i,j:integer):vector;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation{$R *.dfm}

function tform1.fu(a:real;i,j:integer):vector;
begin
  fu[0,i,j]:=a;
end;

procedure TForm1.FormCreate(Sender: TObject);
var i,j:integer;
h:array[0..n,0..n]of real;
u:vector;
begin
  for i:=0 to n do begin
    for j:=0 to n do begin
       h[i,j]:=1;
       u:=fu(h[i,j],i,j);
    end;
  end;
  memo1.Text:='';
  memo1.Lines.Append('h[1,1]='+floattostr(h[1,1]));
  memo1.Lines.Append('u[0,1,1]='+floattostr(u[0,1,1]));
  memo1.Lines.Append('u[0,2,1]='+floattostr(u[0,2,1]));
end;

end.

:)

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.