DUzun's Web
Programare, proiecte personale, divertisment

program p101_8;

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,T,V: data; 

    n,i:integer;

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

procedure normD(var d: data);

begin

   with d do begin

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

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

   end;

end;

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

function MonthDay(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);

     MonthDay := 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, MonthDay(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>MonthDay(v) do begin

       dec(z,MonthDay(v));

       Inc(a, l div 12);

       l := l mod 12+1;

    end;

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

   clrscr;

​

   normD(d);

   adunZile(d,n,v);

   scadZile(d,n,t);

​

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

   writeln;

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

   writeln;

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

​

 until (readkey<>#13);

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

END.

​

​