+ fixed Julian date helpers (based on patch by Bernd Engelhardt, mantis

#16040)
  * finished remaining unimplemented Julian date helpers

git-svn-id: trunk@15032 -

.gitattributes

@@ -10318,6 +10318,7 @@ tests/webtbs/tw15812.pp svneol=native#text/plain
 tests/webtbs/tw15909.pp svneol=native#text/plain
 tests/webtbs/tw1592.pp svneol=native#text/plain
 tests/webtbs/tw15930.pp svneol=native#text/plain
+tests/webtbs/tw16040.pp svneol=native#text/plain
 tests/webtbs/tw1617.pp svneol=native#text/plain
 tests/webtbs/tw1622.pp svneol=native#text/plain
 tests/webtbs/tw1623.pp svneol=native#text/plain

rtl/objpas/dateutil.inc

@@ -2022,43 +2022,58 @@ end;
 {$endif opt Q+}
 
 Function DateTimeToJulianDate(const AValue: TDateTime): Double;
+var
+  day,month,year: word;
+  a,y,m: integer;
 begin
-  DateTimeToJulianDate := AValue - JulianEpoch;
+  DecodeDate ( AValue, year, month, day );
+  a := (14-month) div 12;
+  y := year + 4800 - a;
+  m := month + (12*a) - 3;
+  result := day + ((153*m+2) div 5) + (365*y) + (y div 4) - (y div 100) + (y div 400) - 32045;
+  result := result - 0.5;
 end;
 
 
 Function JulianDateToDateTime(const AValue: Double): TDateTime;
 begin
-  JulianDateToDateTime := AValue + JulianEpoch;
+  if not TryJulianDateToDateTime(AValue, Result) then
-  if(AValue <= 0) or (AValue >= 10000)then
+    raise EConvertError.CreateFmt(SInvalidJulianDate, [AValue]);
-    JulianDateToDateTime := NaN;
 end;
 
 
 Function TryJulianDateToDateTime(const AValue: Double; out ADateTime: TDateTime): Boolean;
+var
+  a,b,c,d,e,m:integer;
+  day,month,year: word;
 begin
-  ADateTime := JulianDateToDateTime(AValue);
+  a := round(AValue + 32044);
-  TryJulianDateToDateTime := ADateTime <> NaN;
+  b := (4*a + 3) div 146097;
+  c := a - (146097*b div 4);
+  d := (4*c + 3) div 1461;
+  e := c - (1461*d div 4);
+  m := (5*e+2) div 153;
+  day := e - ((153*m + 2) div 5) + 1;
+  month := m + 3 - 12 *  ( m div 10 );
+  year := (100*b) + d - 4800 + ( m div 10 );
+  result := TryEncodeDate ( Year, Month, Day, ADateTime );
 end;
 
 Function DateTimeToModifiedJulianDate(const AValue: TDateTime): Double;
 begin
-  Result:=0;
+  result := DateTimeToJulianDate(AValue) - 2400000.5;
-  NotYetImplemented('DateTimeToModifiedJulianDate');
 end;
 
 
 Function ModifiedJulianDateToDateTime(const AValue: Double): TDateTime;
 begin
-  Result:=0;
+  result := JulianDateToDateTime(AValue + 2400000.5);
-  NotYetImplemented('ModifiedJulianDateToDateTime');
 end;
 
 
 Function TryModifiedJulianDateToDateTime(const AValue: Double; out ADateTime: TDateTime): Boolean;
 begin
-  Result:=False;
+  Result:=TryJulianDateToDateTime(AValue + 2400000.5, ADateTime);
-  NotYetImplemented('TryModifiedJulianDateToDateTime');
 end;
 
 {$ifdef RangeCheckWasOn}

tests/webtbs/tw16040.pp

@@ -0,0 +1,29 @@
+uses
+  dateutils;
+var
+  date1,
+  date2: tdatetime;
+  jdate: double;
+begin
+  date1:=EncodeDateTime(2010,03,22,0,0,0,0);
+  date2:=JulianDateToDateTime(2455277.50000);
+  if date1<>date2 then
+    begin
+      writeln(date1:0:12);
+      writeln(date2:0:12);
+      halt(1);
+    end;
+  if DateTimeToJulianDate(date2)<>2455277.50000 then
+    begin
+      writeln(DateTimeToJulianDate(date2):0:5);
+      writeln(2455277.50000:0:5);
+      halt(2);
+    end;
+  jdate:=DateTimeToModifiedJulianDate(date1);
+  if ModifiedJulianDateToDateTime(jdate)<>date1 then
+    begin
+      writeln(jdate:0:12);
+      writeln(date1:0:12);
+      halt(3);
+    end;
+end.