Icon View Thread

The following is the text of the current message along with any replies.
Messages 1 to 2 of 2 total
Thread Julian and the DateTime
Thu, Mar 21 2013 6:23 AMPermanent Link

Walter Matte

Tactical Business Corporation

These may be useful to someone....

Example Usage - need to find the 2 week period start end dates relative to a reference date.

procedure SetPeriodStartEndDates;
var
 refDate, curDate : integer;
begin
 gbStartRefDate := QryCtrl1.Columns['StartRefDate'].AsDateTime;

 refDate := DateToJul(gbStartRefDate);

 curDate := DateToJul(Date);

 while ((curDate - refDate) mod 14) <> 0 do
 begin
   curDate := curDate - 1;
 end;

 gbPeriodStartDate := JulToDate(curDate);
 gbPeriodEndDate   := JulToDate(curDate + 13);

end;



function DateToJul(dt : DateTime) : integer;
Var
 A,B       : integer;
 Year_Corr : double;
 yy,mm,dd  : Integer;
Begin
  yy := YearOf(dt);
  mm := MonthOf(dt);
  dd := DayOf(dt);

  B := 0;
  If mm <= 2 Then
     Begin
        Dec (yy);
        Inc (mm,12);
     End;
  If (yy * 10000.0 + mm * 100.0 + dd >= 15821015.0) Then
     Begin
        A := yy Div 100;
        B := 2 - A + A Div 4;
     End;
  If yy > 0 Then
     Year_Corr := 0.0
  Else
     Year_Corr := 0.75;
  result := integer(Floor((365.25 * yy - Year_Corr)) +
                    Floor((30.6001 * (mm+1) + dd + 1720994 + B)));
end;

function JulToDate(iJ : integer) : DateTime;
var
  mm, yy, dd    : integer;
  A,B,C,D,E,Z,Alpha : integer;
Begin
  Z := iJ + 1;
  If (Z < 2299161) Then
     A := Z
  Else
     Begin
        Alpha := Floor ((Z-1867216.25) / 36524.25);
        A     := Z + 1 + Alpha - Alpha Div 4;
     End;
  B   := A + 1524;
  C   := Floor ((B - 122.1) / 365.25);
  D   := Floor (365.25 * C);
  E   := Floor ((B - D) / 30.6001);
  dd := B - D - Floor (30.6001 * E);
  If E < 13.5 Then
     mm := E - 1
  Else
     mm := E - 13;
  If mm > 2.5 Then
     yy := C - 4716
  Else
     yy := C - 4715;

 result := EncodeDate(yy, mm, dd);
end;


Walter
Thu, Mar 21 2013 2:43 PMPermanent Link

Tim Young [Elevate Software]

Elevate Software, Inc.

Avatar

Email timyoung@elevatesoft.com

Walter,

<< These may be useful to someone.... >>

Very nice, thanks. Smile

Tim Young
Elevate Software
www.elevatesoft.com
Image