Unità Date

Analisi

Unità

Unit LeDate;

Interface

Type
   TData = Record
       Giorno,
       Mese,
       Anno: Integer;
   End;
   DataErrore = Byte;                         { 0..1 }

Procedure DataInit (Var  D: TData;     G, M, A: Integer; Var E: DataErrore);
Procedure DataSplit(     D: TData; Var G, M, A: Integer);
Procedure DataInc  (Var  D: TData; P: Integer);
Procedure DataDec  (Var  D: TData; P: Integer);

Function DateLen  (D1, D2: TData): LongInt;
Function DateComp (D1, D2: TData): ShortInt; { -1..1 }
Function DataDay  (     D: TDATA): Byte;     {  0..6 }

Implementation

Uses  Crt;
Const MaxGiorni: array[1..12, FALSE..TRUE] of Byte = (
         (31, 31), (28, 29), (31, 31), (30, 30), (31, 31), (30, 30),
         (31, 31), (31, 31), (30, 30), (31, 31), (30, 30), (31, 31));

Function AnnoBisestile(Anno: Integer): Boolean;
Begin
   AnnoBisestile:=(Anno Mod 4 = 0) And (Anno Mod 100 <> 0) Or (Anno Mod 400 = 0);
End;

Function DataLegale(D: TData): Boolean;
Var
   G, M, A: Integer;
Begin
   DataSplit(D, G, M, A);
   DataLegale:=(M >= 1) And (M <= 12) And (G >=1) And (G <= MaxGiorni[M, AnnoBisestile(A)]);
Rnd;

Procedure DataInit(var D: TData; G, M, A: Integer; var E: Byte);
Var
   TempData: TDATA;
Begin
   TempData.Giorno:=G;
   TempData.Mese:=M;
   TempData.Anno:=A;
   If(DataLegale(TempData)) Then
      Begin
         E:=0;
         D:=TempData;
      End
   Else
      Begin
         E:=1;
      End;
End;

Procedure DataSplit(D: TData; var G, M, A: Integer);
Begin
   G:=D.Giorno;
   M:=D.Mese;
   A:=D.Anno;
End;

Procedure DataInc1(var D: TData);
Var
   G, M, A: Integer;
   E: DataErrore;
Begin
   DataSplit(D, G, M, A);
   Inc(G);
   If(G > MaxGiorni[M, AnnoBisestile(A)]) Then
      Begin
         G:=1;
         Inc(M);
         If(M = 13) Then
            Eegin
               M:=1;
               Inc(A);
            End;
      End;
   DataInit(D, G, M, A, E);
End;

Procedure DataDec1(var D: TData);
Var
   G, M, A: Integer;
   E: DataErrore;
Begin
   DataSplit(D, G, M, A);
   Dec(G);
   If(G = 0) Then
      Begin
         Dec(M);
         If(M = 0) Then
            Begin
               G:=31;
               M:=12;
               Dec(A);
            End
         Else
            G:=MaxGiorni[M, AnnoBisestile(A)];
      End;
   DataInit(D, G, M, A, E);
End;

Procedure DataInc(var D: TData; P: Integer);
Var
   I: Integer;
Begin
   For I:=1 To P Do
      DataInc1(D);
End;

Procedure DataDec(var D: TData; P: Integer);
Var
   I: Integer;
Begin
   For I:=1 To P Do
      DataDec1(D);
End;

Function DateLen(D1, D2: TData): LongInt;
Var
   R: LongInt;
Begin
   R:=0;
   Case DateComp(D1, D2) Of
      -1: Repeat
              DataInc1(D1);
              Inc(R);
          Until(DateComp(D1, D2) = 0);
       0: ;
       1: Repeat
             DataDec1(D1);
             Dec(R);
          Until(DateComp(D1, D2) = 0);
   End;
   DateLen:=R;
End;

Function DateComp(D1, D2: TData): ShortInt;
Var
   G1, M1, A1, G2, M2, A2: Integer;
Begin
   DataSplit(D1, G1, M1, A1);
   DataSplit(D2, G2, M2, A2);
   If(A1 < A2) Or (A1 = A2) And (M1 < M2) Or (A1 = A2) And (M1 = M2) And (G1 < G2) Then
      DateComp:=-1
   Else If (A1 = A2) And (M1 = M2) And (G1 = G2) Then
      DateComp:=0
   Else
      DateComp:=+1;
End;

{* il 4/1/1998 è DOMENICA, quindi... *}
Function DataDay(D: TData): Byte;
Const
   DataRif: TData = (giorno: 4; mese: 1; anno: 1998);
Var
   Len: ShortInt;
Begin
   Len:=DateLen(DataRif, D) Mod 7;
   If(Len < 0) Then
      Len:=Len+7;
   DataDay:=Len;
End;

Begin
   writeln('ADT data. Anno 2003');
End.

Test

Program DATE_TEST;

Uses Crt, LEDATE;

Procedure DataLeggi(var D: TData);
Var
   G, M, A: Integer;
   E: DataErrore;
Begin
   Repeat
      Readln(G);
      Readln(M);
      Readln(A);
      DataInit(D, G, M, A, E);
   Until(E = 0);
End;

Procedure DataScrivi(D: TData);
Var
   G, M, A: Integer;
Begin
   DataSplit(D, G, M, A);
   Write(G, '/', M, '/', A);
End;

Const
   GG: Integer = 1;
   MM: Integer = 1;
   AA: Integer = 1990;
   PP: Integer = 10;

Var
   D1, D2: TDATA;
   EE    : DataErrore;
   SCELTA: Integer;
Begin
   DataInit(D1, GG, MM, AA, EE);
   DataInit(D2, GG, MM, AA, EE);
   Repeat
      ClrScr;
      Write  ('D1: ');      DataScrivi(D1); Writeln;
      Write  ('D2: ');      DataScrivi(D2); Writeln;
      Writeln('EE: ', EE);                  Writeln;

      Writeln('   0: Uscita');
      Writeln;
      Writeln('1/11: DataInit(D1/2, GG, MM, AA)');
      Writeln('2/22: DataLeggi(D1/2) ');
      Writeln('3/33: DataScrivi(D1/2) ');
      Writeln('4/44: DataIncrementaPeriodo(D1/2, PP)');
      Writeln('5/55: DataDecrementaPeriodo(D1/2, PP)');
      Writeln;
      Writeln('   6: DateDistanza(D1, D2)');
      Writeln('   7: DateConfronta(D1, D2) ');
      Writeln('  10: DataDay(D1)');
      Writeln;
      Writeln('  81: GG=', GG, ' 82: MM=', MM, ' 83: AA=', AA, ' 84: PP=', PP);
      Writeln;
      Write  ('Scegli ');
      Readln(SCELTA);

      Case SCELTA Of
           1: DataInit(D1, GG, MM, AA, EE); 11: DataInit(D2, GG, MM, AA, EE);
           2: DataLeggi(D1);                22: DataLeggi(D2);
           3: DataScrivi(D1);               33: DataScrivi(D2);
           4: DataInc(D1, PP);              44: DataInc(D2, PP);
           5: DataDec(D1, PP);              55: DataDec(D2, PP);
           6: write(DateLen(D1, D2));        7: write(DateComp(D1, D2));
          10: Case DataDay(D1) of
                 0:   Write('Domenica');
                 1:   Write('Lunedì');
                 2:   Write('Martedì');
                 3:   Write('Mercoledì');
                 4:   Write('Giovedì');
                 5:   Write('Venerdì');
                 6:   Write('Sabato');
                 Else
                      Write('Boh!');
              End;
          81: Readln(GG); 82: Radln(MM); 83: Readln(AA); 84: Readln(PP);
      End;
      Gotoxy(25, 25);
      Write('Invio...');
      Readln;
   Until(SCELTA = 0);
End.