Nugroho's blog.: delphi
Showing posts with label delphi. Show all posts
Showing posts with label delphi. Show all posts

Thursday, March 14, 2019

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);
.

Thursday, May 18, 2017

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.


.

Tuesday, May 16, 2017

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.



Monday, May 15, 2017

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.

.

Thursday, April 27, 2017

"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.

Thursday, April 20, 2017

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


Thursday, April 13, 2017

Flappy Bird Like in Delphi

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



Tuesday, April 11, 2017

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;






Monday, April 10, 2017

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.


.

Wednesday, November 18, 2015

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;

.









Thursday, November 12, 2015

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

Saturday, October 3, 2015

Fourier Transform using Delphi

 It's not Discrete Fourier Transform.

 Instead, I use continue definition (using Integral, not Sum) to compute the transformation. I know, it's weird, but it's worth a try, :)

 What I did is transform signal with 3 frequency, remove the two frequency and trasform back to time-signal.










unit Unit1;

interface

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

type
TForm1 = class(TForm)
Image1: TImage;
Timer1: TTimer;
Memo1: TMemo;
Image2: TImage;
Image3: TImage;
Image4: TImage;
procedure proses;
procedure gambarFungsi;
procedure gambarSumbu;
procedure gambarTransformasi;
procedure olahTransformasi;
procedure gambarOlahTransformasi;
procedure transformasiBalik;
procedure gambarTransformasibalik;
function f(x:real):real;
procedure Timer1Timer(Sender: TObject);
private
public
end;

const
a=200;
b=150;

var
Form1: TForm1;
x0,y0,xm,ym:integer;
s,ss:array[-a..a]of real;
ft:array[-b..b]of real;
implementation
{$R *.dfm}
function tform1.f(x:real):real;
begin
f:=cos(PI*x)+cos(2*PI*x)+cos(4*PI*x);
end;
procedure tform1.transformasiBalik;
var i,j:integer;
t,w,dt:real;
begin{}
dt:=0.1;
for i:=-a to a do begin
w:=i/10;
ss[i]:=0;
for j:=-b to b do begin
t:=j/10;
ss[i]:=ss[i]+ft[j]*cos(w*t)*dt
end;
end;
gambarTransformasiBalik;
end;

procedure tform1.olahTransformasi;
var i:integer;
begin
for i:=-b to b do begin
if abs(i)>50 then ft[i]:=0;
end;
gambarOlahTransformasi;
end;

procedure tform1.proses;
var i,j:integer;
t,w,dt:real;
begin
form1.Caption:='transformasi';
gambarSumbu;
{transformasi}
dt:=0.1;
for i:=-a to a do begin
s[i]:=f(i/30);
end;
for i:=-b to b do begin
w:=i/10;
ft[i]:=0;
for j:=-a to a do begin
t:=j/10;
ft[i]:=ft[i]+f(t)*cos(w*t)*dt
end;
end;
gambarFungsi;
gambarTransformasi;
olahTransformasi;
transformasiBalik;
end;

procedure tform1.gambarFungsi;
var i,xo,yo,xt,yt:integer;
begin
xo:=-a; yo:=0;
for i:=-a to a do begin
xt:=i;
yt:=round(10*s[i]);
with image1.Canvas do begin
moveto(x0+xo,y0-yo);lineto(x0+xt,y0-yt);
end;
xo:=xt;
yo:=yt;
end;
end;

procedure tform1.gambarTransformasibalik;
var i,xo,yo,xt,yt:integer;
begin
xo:=-a; yo:=0;
for i:=-a to a do begin
xt:=i;
yt:=round(10*ss[i]);
with image4.Canvas do begin
moveto(x0+xo,y0-yo);lineto(x0+xt,y0-yt);
end;
xo:=xt;
yo:=yt;
end;
end;

procedure tform1.gambarOlahTransformasi;
var i,xo,yo,xt,yt:integer;
begin
{}
xo:=-b; yo:=0;
for i:=-b to b do begin
xt:=i;
yt:=round(10*ft[i]);
with image3.Canvas do begin
moveto(x0+xo,y0-yo);lineto(x0+xt,y0-yt);
end;
xo:=xt;
yo:=yt;
end;
end;

procedure tform1.gambarTransformasi;
var i,xo,yo,xt,yt:integer;
begin
xo:=-b;yo:=0;
for i:=-b to b do begin
xt:=i;
yt:=round(10*ft[i]);
with image2.Canvas do begin
moveto(x0+xo,y0-yo);lineto(x0+xt,y0-yt);
end;
xo:=xt;
yo:=yt;
end;
end;

procedure tform1.gambarSumbu;
begin
x0:=image1.Width div 2;
y0:=image1.Height div 2;
xm:=image1.Width;
ym:=image1.Height;
with image1.Canvas do begin
moveto(0,y0);lineto(xm,y0);moveto(x0,0);lineto(x0,ym);
end;
with image2.Canvas do begin
moveto(0,y0);lineto(xm,y0);moveto(x0,0);lineto(x0,ym);
end;
with image3.Canvas do begin
moveto(0,y0);lineto(xm,y0);moveto(x0,0);lineto(x0,ym);
end;
with image4.Canvas do begin
moveto(0,y0);lineto(xm,y0);moveto(x0,0);lineto(x0,ym);
end;
end;

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

end.

Friday, December 5, 2014

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.

:)

Wednesday, November 26, 2014

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.

Monday, November 17, 2014

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>

Friday, November 14, 2014

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