home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / datetime.swg / 0005_DATE4.PAS.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  1.8 KB  |  82 lines
  1. {
  2.  I need an accurate method of converting back and
  3.  Forth between Gregorian and Julian dates.  if anyone
  4. }
  5.  
  6. Procedure GregoriantoJulianDN;
  7.  
  8. Var
  9.   Century,
  10.   XYear    : LongInt;
  11.  
  12. begin {GregoriantoJulianDN}
  13.   if Month <= 2 then begin
  14.     Year := pred(Year);
  15.     Month := Month + 12;
  16.     end;
  17.   Month := Month - 3;
  18.   Century := Year div 100;
  19.   XYear := Year mod 100;
  20.   Century := (Century * D1) shr 2;
  21.   XYear := (XYear * D0) shr 2;
  22.   JulianDN := ((((Month * 153) + 2) div 5) + Day) + D2 + XYear + Century;
  23. end; {GregoriantoJulianDN}
  24.  
  25. {**************************************************************}
  26.  
  27. Procedure JulianDNtoGregorian;
  28.  
  29. Var
  30.   Temp,
  31.   XYear   : LongInt;
  32.   YYear,
  33.   YMonth,
  34.   YDay    : Integer;
  35.  
  36. begin {JulianDNtoGregorian}
  37.   Temp := (((JulianDN - D2) shl 2) - 1);
  38.   XYear := (Temp mod D1) or 3;
  39.   JulianDN := Temp div D1;
  40.   YYear := (XYear div D0);
  41.   Temp := ((((XYear mod D0) + 4) shr 2) * 5) - 3;
  42.   YMonth := Temp div 153;
  43.   if YMonth >= 10 then begin
  44.     YYear := YYear + 1;
  45.     YMonth := YMonth - 12;
  46.     end;
  47.   YMonth := YMonth + 3;
  48.   YDay := Temp mod 153;
  49.   YDay := (YDay + 5) div 5;
  50.   Year := YYear + (JulianDN * 100);
  51.   Month := YMonth;
  52.   Day := YDay;
  53. end; {JulianDNtoGregorian}
  54.  
  55.  
  56. {**************************************************************}
  57.  
  58. Procedure GregoriantoJulianDate;
  59.  
  60. Var
  61.   Jan1,
  62.   today : LongInt;
  63.  
  64. begin {GregoriantoJulianDate}
  65.   GregoriantoJulianDN(Year, 1, 1, Jan1);
  66.   GregoriantoJulianDN(Year, Month, Day, today);
  67.   JulianDate := (today - Jan1 + 1);
  68. end; {GregoriantoJulianDate}
  69.  
  70. {**************************************************************}
  71.  
  72. Procedure JuliantoGregorianDate;
  73.  
  74. Var
  75.   Jan1  : LongInt;
  76.  
  77. begin
  78.   GregoriantoJulianDN(Year, 1, 1, Jan1);
  79.   JulianDNtoGregorian((Jan1 + JulianDate - 1), Year, Month, Day);
  80. end; {JuliantoGregorianDate}
  81.  
  82.