DUzun's Web
Programare, proiecte personale, divertisment

Program P9; { ~ p101(9)_8.pas }

{--------------------------------------------------------------

   Sa se defineasca un subprogram care va:

   a) aduna o data calendaristica cu un nr de zile, 

      rezultatul fiind o data calendaristica

   b) ... cu un nr de luni, ...

   c) scadea dintro data calendaristica un nr de zile, ...

   d) ... un nr de luni, ...

   e) scadea 2 date calendaristice, 

      resultatul fiind nr de zile dintre aceste date.

 --------------------------------------------------------------}

uses  crt;

{--------------------------------------------------------------}

const DaysInMon: array[1..12]of byte = (31,28,31,30,31,30,31,31,30,31,30,31);

{--------------------------------------------------------------}

type  data = record z, l, a: integer; end; 

{--------------------------------------------------------------}

var d, V:  data; 

    n, li: integer;

{--------------------------------------------------------------}

procedure normD(var d: data);

begin

   with d do begin

     a := abs(a);

     l:=(abs(l)+11)mod 12+1;

     z:=(abs(z)+DaysInMon[l]-1) mod DaysInMon[l]+1;

   end;

end;

{--------------------------------------------------------------}

function MonthDays(d: data): integer;

begin

  with d do begin

     z := DaysInMon[l];

     {Regula calendarului Gregorian}

     if(l = 2)and(a mod 4 = 0)and(a mod 100 <> 0) then inc(z);

     MonthDays := z;

  end;

end;

{--------------------------------------------------------------}

function DataDays(d: data): longint;

begin

  with d do begin

     while(l>0)do begin inc(z, DaysInMon[l]); dec(l); end;

     DataDays := a * 365 + a div 4 - a div 400 + z;

  end;

end;

{--------------------------------------------------------------}

procedure scadZile(d: data; i: word;var t: data);

begin

  t := d;

  with t do begin

    dec(z, i);

    While z<=0 do begin

       l:=(l+11) mod 12;

       if l=0 then begin dec(a); l:=12; end;

       inc(z, MonthDays(t));

    end;

  end;

end;

{--------------------------------------------------------------}

procedure adunZile(d: data; i: integer;var v: data);

begin

  if i < 0 then scadZile(d,-i,v) else

  with v do begin

    v := d;

    inc(z,i);

    While z>MonthDays(v) do begin

       dec(z,MonthDays(v));

       Inc(a, l div 12);

       l := l mod 12+1;

    end;

  end;

end;

{--------------------------------------------------------------}

procedure adunLuni(d: data; li: integer;var v: data);

begin

   v := d;

   with v do begin

      inc(l, li);

      inc(a, l div 12); 

      l := (l mod 12 + 11) mod 12 + 1; 

   end;

end;

{--------------------------------------------------------------}

function scadDat(d1,d2: data): integer;

begin

  with d1 do begin

    dec(z, d2.z);

  end;

end;

{--------------------------------------------------------------}

BEGIN

 repeat

   clrscr;

   Writeln('Introdu data (ziua(1-31), luna(1-12), anul):');

   with d do readln(z,l,a);

   Writeln('Introdu nr de zile:');readln(n);

   Writeln('Introdu nr de luni:');readln(li);

   normD(d);

   clrscr;

​

   with d do writeln('Data curenta: ',z,'.',l,'.',a);

   writeln;  adunZile(d,n,v);

   with V do writeln('a) Peste ',n,' zile va fi data: ',#13#10,z,'.',l,'.',a);

   writeln;  adunLuni(d,li,v);

   with V do writeln('b) Peste ',li,' luni va fi data: ',#13#10,z,'.',l,'.',a);

   writeln;  scadZile(d,n,v);

   with V do writeln('c) Cu ',n,' zile in urma a fost data: ',#13#10,z,'.',l,'.',a);

   writeln;  adunLuni(d,-li,v);

   with V do writeln('d) Cu ',li,' luni in urma a fost data: ',#13#10,z,'.',l,'.',a);

   readkey;

​

   clrscr;

   Writeln('Introdu o data calendaristica (ziua(1-31), luna(1-12), anul):');

   with v do readln(z,l,a);

   normD(v);

   clrscr;

   writeln('e)');

   with d do write(z,'.',l,'.',a, ' - ');

   with v do write(z,'.',l,'.',a, ' = ');

   writeln(DataDays(d)-DataDays(v), ' zile')

 until (readkey<>#13);

{--------------------------------------------------------------}

END.

​

​