Subj : Re: Julian to String Date [1/2]
To   : Dan Egli
From : Leonard Erickson
Date : Mon Feb 09 2004 03:40 pm

 >>> Part 1 of 2...

 -=> Quoting Scott Adams to Dan Egli <=-

 -=> Quoting Dan Egli to All <=-
 
 DE> Hey all. I need someone to double check my logic here, if you please.
 DE> I am writing a function that takes a julian date (i.e. 030) and
 DE> returns the String Date it represents(i.e. 01/30/<this year>). I wrote
 DE> this function to do it. I am sure there is a more elegant way but I
 DE> can not think of it. Basically I don't care as long as it works. So I
 DE> want someone to double check it to see if they can see any flaws in my
 DE> logic (entirely possible!). 
 DE> This is for FreePascal so most Delphi 2.0 types are valid.

"Julian date" is a term that can refer to any of *several* things (date
expressed as "year & day of year, date in the Julian (as opposed to
Gregorian) calendar, etc). It also gets comnfused with the Julian day
number. 

if ancient TP code is ok, here's a unit that does that and more. 
What you want are day_of_year and reverse_day_of_year.

UNIT datetime;
INTERFACE
USES
dos;
  
TYPE
date = STRING[10];
  
VAR
dterror : STRING;
  
FUNCTION validate_datestr(dt:STRING):BOOLEAN;
FUNCTION valid_date_range(d,mn,y:word):BOOLEAN;
FUNCTION validate_timestr(tm:STRING):BOOLEAN;
FUNCTION ReverseJulianDate(JD:longint):date;
FUNCTION reverse_day_of_year(n,y:word):date;
  
FUNCTION day_of_week(d,mn,y:word):word;     {Zeller's congruence}
FUNCTION leap_year(year:word):BOOLEAN;
FUNCTION valid_date(d,mn,y:word):BOOLEAN;
FUNCTION valid_datestr_format(dt:STRING):BOOLEAN;
FUNCTION valid_time(h,m,s:word):BOOLEAN;
FUNCTION valid_timestr_format(tm:STRING):BOOLEAN;
FUNCTION day_of_year(d,mn,y:word):word;
FUNCTION JulianDate(d,mn,y:word):longint;
PROCEDURE JulianDayToDate(jd:longint;VAR d,mn,y:word);
PROCEDURE DayOfYearToDate(dy,y:word;VAR d,mn:word);
FUNCTION DateToDateStr(d,mn,y,l:word):STRING;
  
IMPLEMENTATION
  
{----------------------------------------------------------------------}
  
FUNCTION validate_datestr(dt:STRING):BOOLEAN;
  VAR
    d,mn,y,code : INTEGER;
    flag : BOOLEAN;
BEGIN
  flag := valid_datestr_format(dt);
  
  IF flag THEN
  BEGIN
    VAL(COPY(dt,1,2),mn,code);
    VAL(COPY(dt,4,2),d,code);
    VAL(COPY(dt,7,2),y,code);
  END;

  IF flag THEN flag := Valid_Date(d,mn,y);
  IF flag THEN flag := valid_date_range(d,mn,y);
  
  validate_datestr := flag;
END;
  
{----------------------------------------------------------------------}
  
FUNCTION valid_date_range(d,mn,y:word):BOOLEAN;
  VAR
    flag : BOOLEAN;
    td,tmn,ty,tdw : word;
    lo_jd,hi_jd,jd : longint;
BEGIN
  flag := TRUE;
  dterror := '';
  GetDate(ty,tmn,td,tdw);
  lo_jd := JulianDate(1,1,1980);
  hi_jd := JulianDate(td,tmn,ty);
  
  jd := JulianDate(d,mn,1900+y);
  
  flag := jd>=lo_jd;
  IF flag THEN
  BEGIN
    flag := jd<=hi_jd;
    IF NOT flag THEN
      dterror := 'Date cannot be later than today!';
  END
  ELSE
    dterror := 'Year cannot be before 1980!';
  
  valid_date_range := flag
END;
  
{----------------------------------------------------------------------}
  
FUNCTION validate_timestr(tm:STRING):BOOLEAN;
  VAR
    h,m,s,code : INTEGER;
    flag : BOOLEAN;
BEGIN
  IF tm <> '        ' THEN
  BEGIN
    flag := valid_timestr_format(tm);
  
    IF flag THEN
    BEGIN
      VAL(COPY(tm,1,2),h,code);
      VAL(COPY(tm,4,2),m,code);
      VAL(COPY(tm,7,2),s,code);
    END;
  
    IF flag THEN flag := Valid_Time(h,m,s);
  
  END;
  validate_timestr := flag;
END;
  
{----------------------------------------------------------------------}
  
FUNCTION ReverseJulianDate(JD:longint):date;
{ y=4 digit year
 mn=month
  d=day of month}
  VAR
    y, mn, d  : word;
BEGIN
  JulianDayToDate(jd,d,mn,y);
  ReverseJulianDate := DateToDateStr(d,mn,y,10);
END;
  
{----------------------------------------------------------------------}
  
FUNCTION reverse_day_of_year(n,y:word):date;
{ y=4 digit year
  n=day of year
 mn=month
  d=day of month}
  VAR
    mn,d : word;
BEGIN
  DayOfYearToDate(n,y,d,mn);
  Reverse_day_of_year := DateToDateStr(d,mn,y,10);
END; {reverse_day_of_year}
  
{----------------------------------------------------------------------}
  
FUNCTION day_of_week(d,mn,y:word):word;     {Zeller's congruence}
{returns day of week (0 thru 6)}
{ y=4 digit year
 mn=month
  d=day of month
 c8=century
 d8=year in century
 m8=adjusted month
 y8=adjusted year}
  VAR
    c8,d8,m8,y8 : longINT;
    dw : INTEGER;
BEGIN
  IF mn>2 THEN
  BEGIN
    m8 := mn-2;
    y8 := y;
  END
  ELSE
  BEGIN
    m8 := mn+10;
    y8 := y-1;
  END;
  c8 := y8 DIV 100;
  d8 := y8 MOD 100;
  dw := ((13*m8-1) DIV 5+d+d8+d8 DIV 4+c8 DIV 4-c8-c8) MOD 7;
  day_of_week := (dw+7) MOD 7;
END;
  
{----------------------------------------------------------------------}
  
FUNCTION leap_year(year:word):BOOLEAN;
BEGIN
  leap_year := FALSE;
  IF (year MOD   4)=0 THEN leap_year := TRUE;
  IF (year MOD 100)=0 THEN leap_year := FALSE;
  IF (year MOD 400)=0 THEN leap_year := TRUE;
END;
  
{----------------------------------------------------------------------}
  
FUNCTION valid_date(d,mn,y:word):BOOLEAN;
  VAR
    flag : BOOLEAN;
BEGIN
  CASE mn OF
  1,3,5,7,8,10,12 : BEGIN
      flag := d<32;
      dterror := 'Only 31 days in that month!';
    END;
  2               : BEGIN
      IF leap_year(y) THEN
      BEGIN
        flag := d<30;
        dterror := 'Only 29 days in that month!';
      END
      ELSE
      BEGIN
        flag := d<29;
        dterror := 'Only 28 days in that month!';
      END;
    END;
  4,6,9,11        : BEGIN
      flag := (d<31);
      dterror := 'Only 31 days in that month!';
    END;
  ELSE
      flag := FALSE;
    dterror := 'Illegal month!';
  END;
  IF flag THEN dterror := '';
  valid_date := flag;
END;
  
{----------------------------------------------------------------------}
  
FUNCTION valid_datestr_format(dt:STRING):BOOLEAN;
  CONST
    msg = 'Correct format is MM-DD-YY.';
  VAR
    ctr : INTEGER;
    flag : BOOLEAN;
BEGIN
  flag := TRUE;
  dterror :='';

  FOR ctr := 1 TO 8 DO
  CASE dt[ctr] OF
  '0'..'9','-' : flag := flag
  ELSE
      flag := FALSE;
  END;
  IF NOT flag THEN dterror :='Illegal character! '+msg;

  flag := flag AND (dt[3] = '-') AND (dt[6] = '-');
  IF NOT flag THEN dterror := 'Missing hyphen! '+msg;

  flag := flag AND (dt[1] <> '-') AND (dt[2] <> '-') AND (dt[4] <> '-') AND
      (dt[5] <> '-') AND (dt[7] <> '-') AND (dt[8] <> '-');
  IF NOT flag THEN dterror := 'Extra hyphen! '+msg;

  valid_datestr_format := flag;
END;

{----------------------------------------------------------------------}

FUNCTION valid_time(h,m,s:word):BOOLEAN;
  VAR
    flag : BOOLEAN;
BEGIN
  flag := TRUE;
  IF ((h>23) OR (h<0)) THEN
  BEGIN
    dterror :='Illegal hour!';
    flag := FALSE;
  END;
  
  IF flag AND ((m>59) OR (m<0)) THEN
  BEGIN
    dterror := 'Illegal minute!';
    flag := FALSE;
  END;
  
  IF flag AND ((s>59) OR (s<0)) THEN
  BEGIN
    dterror := 'Illegal second!';
    flag := FALSE;
  END;
  valid_time := flag;
END;
  
{----------------------------------------------------------------------}
  
FUNCTION valid_timestr_format(tm:STRING):BOOLEAN;
  CONST
    msg = 'Correct format is HH:MM:SS.';
  VAR
    ctr : INTEGER;
    flag : BOOLEAN;
BEGIN
  flag := TRUE;
  
  IF tm <> '        ' THEN
  BEGIN
    dterror :='';
    FOR ctr := 1 TO 8 DO
    CASE tm[ctr] OF
    '0'..'9',':' : flag := flag
    ELSE
        flag := FALSE;
    END;
    IF NOT flag THEN dterror :='Illegal character! '+msg;
  
    IF flag AND ((tm[3] <> ':') OR (tm[6] <> ':')) THEN
      dterror := 'Missing colon! '+msg;
  
    IF flag AND ((tm[1] = ':') OR (tm[2] = ':') OR (tm[4] = ':') OR
      (tm[5] = ':') OR (tm[7] = ':') OR (tm[8] = ':')) THEN
      dterror := 'Extra colon! '+msg;
  END;
  valid_timestr_format := flag;
END;
  
{----------------------------------------------------------------------}
  
FUNCTION day_of_year(d,mn,y:word):word;
{ y=4 digit year
 mn=month
  d=day of month}
  VAR
    l,t : word;
BEGIN
  t := (3055*(mn+2) DIV 100)-91;
  IF leap_year(y) THEN
    l := 1
  ELSE
    l := 0;
  IF mn>2 THEN t := t-2+l;
  day_of_year := t+d;
END;
  
{----------------------------------------------------------------------}
  
FUNCTION JulianDate(d,mn,y:word):longint;
{ y=4 digit year
 mn=month
  d=day of month
 c8=century
 d8=year in century
 m8=adjusted month
 y8=adjusted year}
  VAR
    c8,d8,m8,y8:longINT;
BEGIN
  IF mn>2 THEN
  BEGIN
    m8 := mn-3;
    y8 := y;
  END
  ELSE
  BEGIN
    m8 := mn+9;
    y8 := y-1;
  END;
  c8 := y8 DIV 100;
  d8 := y8 MOD 100;
  JulianDate := (146097*c8 DIV 4)+d+(1461*d8 DIV 4)+1721119+(153*m8+2) DIV 5;
END;
  
{----------------------------------------------------------------------}
  
PROCEDURE JulianDayToDate(JD:longint;VAR d,mn,y:word);
{ y=4 digit year
 mn=month
  d=day of month
 t1,t2,t3=temp value}
  VAR
    yt, mt, dt : longint;
BEGIN
  mt := JD-1721119;
  yt := (4*mt-1) DIV 146097;
  mt := 4*mt-1-146097*yt;
  dt := mt DIV 4;
  mt := (4*dt+3) DIV 1461;
  dt := 4*dt+3-1461*mt;
  dt := (dt+4) DIV 4;
  mn := (5*dt-3) DIV 153;
  dt := 5*dt-3-153*mn;
  d  := (dt+5) DIV 5;
  y  := 100*yt+mt;
  IF mn<10 THEN
    mn := mn+3
  ELSE
  BEGIN
    mn := mn-9;
    y := y+1;
  END;
END;
  
{----------------------------------------------------------------------}

 >>> Continued to next message...

--- FMailX 1.60
 * Origin: Shadowgard (1:105/50)

.