home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / swag / datetime.swg / 0004_DATE3.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  3KB  |  87 lines
  1. Program Gregorian;              { Julian day to Gregorian date      }
  2. Uses    Crt;                    { Turbo/Quick Pascal                }
  3. Type    String3         = String[3];
  4.         String9         = String[9];
  5. Const   MonthName       : Array [1..12] of String3 =
  6.                           ('Jan','Feb','Mar','Apr','May','Jun',
  7.                            'Jul','Aug','Sep','Oct','Nov','Dec');
  8.         DayName         : Array [1..7] of String9 =
  9.                           ('Sunday','Monday','Tuesday','Wednesday',
  10.                            'Thursday','Friday','Saturday');
  11. Var     Day, JulianDay, F       : Real;
  12.         Month                   : Byte;
  13.         Year                    : Integer;
  14.         A, B, C, D, E, G, Z     : LongInt;
  15.         LeapYear                : Boolean;
  16.  
  17. Function DayofWeek( Month : Byte; Day : Real; Year : Integer ): Byte;
  18.         Var     iVar1, iVar2    : Integer;
  19.         begin
  20.                 iVar1 := Year MOD 100;
  21.                 iVar2 := TRUNC( Day ) + iVar1 + iVar1 div 4;
  22.                 Case Month of
  23.                         4, 7    : iVar1 := 0;
  24.                         1, 10   : iVar1 := 1;
  25.                         5       : iVar1 := 2;
  26.                         8       : iVar1 := 3;
  27.                         2,3,11  : iVar1 := 4;
  28.                         6       : iVar1 := 5;
  29.                         9,12    : iVar1 := 6;
  30.                         end; {Case}
  31.                 iVar2 := ( iVar1 + iVar2 ) MOD 7;
  32.                 if ( iVar2 = 0 ) then iVar2 := 7;
  33.                 DayofWeek := Byte( iVar2 );
  34.         end; {DayofWeek}
  35.  
  36. Function DayofTheYear( Month : Byte; DAY : Real ): Integer;
  37.         Var     N       : Integer;
  38.         begin
  39.                 if LeapYear  then N := 1  else N := 2;
  40.                 N := 275 * Month div 9
  41.                      - N * (( Month + 9 ) div 12)
  42.                      + TRUNC( Day ) - 30;
  43.                 DayofTheYear := N;
  44.         end; {DayofTheYear}
  45.  
  46. begin   {Gregorian}
  47.         ClrScr;
  48.         WriteLn('Gregorian dates v0.0 Dec.91 Greg Vigneault');
  49.         WriteLn('[Enter Julian day values]');
  50.  
  51.         Repeat  WriteLn;
  52.                 Write('Enter (positive) Julian day number: ');
  53.                 ReadLn( JulianDay );
  54.         Until   ( JulianDay >= 706.0 );
  55.  
  56.         JulianDay := JulianDay + 0.5;
  57.         Z := TRUNC( JulianDay );   F := FRAC( JulianDay );
  58.  
  59.         if ( Z < 2299161 )
  60.         then    A := Z
  61.         else    begin   G := TRUNC( ( Z - 1867216.25 ) / 36524.25);
  62.                         A := Z + 1 + G - G div 4;
  63.                 end; {if}
  64.  
  65.         B := A + 1524;  C := TRUNC( ( B - 122.1 ) / 365.25 );
  66.         D := TRUNC( 365.25 * C );  E := TRUNC( ( B - D ) / 30.6001 );
  67.  
  68.         Day := B - D - TRUNC( 30.6001 * E ) + F;
  69.  
  70.         if ( E < 13.5 )
  71.         then Month := Byte( E - 1 )
  72.         else if ( E > 13.5 ) then Month := Byte( E - 13 );
  73.  
  74.         if ( Month > 2.5 )
  75.         then Year := Integer( C - 4716 )
  76.         else if ( Month < 2.5 ) then Year := Integer( C - 4715 );
  77.  
  78.         if ((Year MOD 100)<>0) and ((Year MOD 4)=0)
  79.                 then    LeapYear := True
  80.                 else    LeapYear := False;
  81.  
  82.         Write(#10,'Gregorian '); if LeapYear then Write('LeapYear ');
  83.         WriteLn('date is ',DayName[DayofWeek(Month,Day,Year)],
  84.                 ', ',MonthName[ Month ],' ',Day:2:2,',',Year:4,
  85.                  ' (day of year= ',DayofTheYear(Month,Day),')',#10);
  86. end. {Gregorian}
  87.