DUzun's Web
Programare, proiecte personale, divertisment

unit p166_8a;{14}

interface

​

type Fractie=record

      nr:integer; {Numaratorul}

      nm:word;    {Numitorul}

     end;

     FracStr=String[14];

​

Procedure SumF(a,b:Fractie;var c:Fractie);

Procedure DifF(a,b:Fractie;var c:Fractie);

Procedure ProdF(a,b:Fractie;var c:Fractie);

Function CatF(a,b:Fractie;var c:Fractie):boolean;

Procedure SimplF(var a:Fractie);

Procedure PutF(var a:Fractie;n:word);

Function CompF(a,b:Fractie):byte; {0: a<b; 1: a=b; 2: a>b; 3: erroare}

​

Procedure AttrF(Var A:Fractie;nr:integer;nm:word);

Procedure ClearF(var a:Fractie);

Function FrStr(a:Fractie;Paranteze:boolean):FracStr;

​

{Aditionale}

function min(a,b:integer):integer;

function max(a,b:integer):integer;

Function Put(a:integer;n:word):integer;

function divcom(a,b:integer):integer;

function multcom(a,b:integer):integer;

​

implementation

​

Procedure SumF;

begin

 if (a.nm=0)or(b.nm=0)then exit;

 C.nm:=MultCom(a.nm,b.nm);

 with C do Nr:=a.nr*(nm div a.nm)+b.nr*(nm div b.nm);

end;

​

Procedure DifF;

begin

 if (a.nm=0)or(b.nm=0)then exit;

 C.nm:=MultCom(a.nm,b.nm);

 with C do Nr:=a.nr*(nm div a.nm)-b.nr*(nm div b.nm);

end;

​

Procedure ProdF;

begin

 if (a.nm=0)or(b.nm=0)then exit;

 with C do begin

  Nr:=a.nr*b.nr;

  Nm:=a.nm*b.nm;

 end;

end;

​

Function CatF;

begin

 CatF:=False;

 if (a.nm=0)or(b.nr=0)then exit;

 with C do begin

  Nr:=a.nr*b.nm*(b.nr div abs(b.nr));

  Nm:=a.nm*abs(b.nr);

 end;

 CatF:=True;

end;

​

Procedure SimplF;

var d:word;

begin

 if (a.nm=0)then exit;

 With A do begin

  d:=DivCom(nr,nm);

  nr:=nr div d;

  nm:=nm div d;

 end;

end;

​

Procedure PutF;

begin

 if (a.nm=0)then exit;

 SimplF(A);

 With A do begin

  nr:=Put(nr,n);

  nm:=Put(nm,n);

 end;

end;

​

Function CompF;

var r1,r2:Real;

begin

 CompF:=3;

 if (a.nm=0)or(b.nm=0)then exit;

 with a do r1:=Nr/Nm;

 with b do r2:=Nr/Nm;

 if r1<r2 then CompF:=0 else if r1=r2 then CompF:=1 else CompF:=2;

end;

​

Procedure AttrF;begin a.nr:=nr;a.nm:=nm;end;

​

Procedure ClearF;begin a.nr:=0;a.nm:=1;end;

​

Function FrStr;

var s1,s2:string[6];

begin

 with a do begin

  Str(nr,s1);

  Str(nm,s2);

  if Paranteze then begin s1:='('+s1; s2:=s2+')';end;

 end; FrStr:=s1+'/'+s2;

end;

​

{Aditionale}

function min;begin min:=(a+b-abs(a-b))div 2;end;

function max;begin max:=(a+b+abs(a-b))div 2;end;

​

Function Put; var i,p:integer;

begin p:=1; for i:=1 to n do p:=p*a; Put:=p; end;

​

function divcom;

var i:integer; d:integer;

begin

 d:=1;

 for i:=min(a,b) downto 2 do

  if (a mod i=0)and(b mod i=0)and(d mod i<>0)then d:=d*i;

 divcom:=d;

end;

​

function multcom;

var M,i:integer;

begin

 m:=max(a,b);

 for i:=Min(a,b) downto 2 do

  if(Min(a,b) mod i=0)and(DivCom(m,i)<>i)then m:=m div DivCom(m,i)*i;

  multcom:=m;

end;

end.

​