Nugroho's blog.: Digital Counter with Reset and Preset/Clear

Monday, November 17, 2014

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>

No comments:

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