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>