[Back to DATETIME SWAG index] [Back to Main SWAG index] [Original]

    Unit Julian;
    {DEMO Routines
    /begin
    /  ClrScr;
    /  GetDate(Year,Month,Day,Dow);
    /  WriteLn('Year  : ',Year);
    /  WriteLn('Month : ',Month);
    /  WriteLn('Day   : ',Day);
    /  WriteLn('doW   : ',Dow);
    /  WriteLn(MachineDate);
    /  JulianDate := DatetoJulian(MachineDate);
    /  WriteLn('Julian Date = ',JulianDate);
    /  WriteLn('Jul to Date = ',JuliantoDate(JulianDate));
    /  WriteLn('Day of Week = ',DayofWeek(JulianDate));
    /  WriteLn('Time        = ',MachineTime(4));
    /end.}
    Interface

    Uses Crt, Dos;

    Type
      Str3  = String[3];
      Str8  = String[8];
      Str9  = String[9];
      Str11 = String[11];

    Var
      Hour,Minute,Second,S100,
      Year,Month,Day,Dow     : Word;
      Syear,Smonth,Sday,Sdow : String;
      JulianDate             : Integer;

    Function MachineTime(Len : Byte) : Str11;
    Function MachineDate : Str8;
    Function DateFactor(MonthNum, DayNum, YearNum : Real) : Real;
    Function DatetoJulian(DateLine : Str8) : Integer;
    Function JuliantoDate(DateInt : Integer): Str11;
    Function JuliantoStr8(DateInt : Integer): Str8;
    Function DayofWeek(Jdate : Integer) : Str3;
    Procedure DateDiff(Date1,Date2 : Integer; Var Date_Difference : Str9);

    Implementation
    Function MachineTime(Len : Byte) : Str11;
    Var
      I       : Byte;
      TempStr : String;
      TimeStr : Array[1..4] of String;
    begin
      TempStr := ''; FillChar(TimeStr,Sizeof(TimeStr),0);
      GetTime(Hour,Minute,Second,S100);
      Str(Hour,TimeStr[1]);
      Str(Minute,TimeStr[2]);
      Str(Second,TimeStr[3]);
      Str(S100,TimeStr[4]);
      TempStr := TimeStr[1];
      For I := 2 to Len Do TempStr := TempStr + ':' + TimeStr[I];
      MachineTime := TempStr;
    end;

    Function MachineDate : Str8;
    begin
      GetDate(Year,Month,Day,Dow);
      Str(Year,Syear);
      Str(Month,Smonth);
      if Month < 10 then Smonth := '0' + Smonth;
      Str(Day,Sday);
      if Day < 10 then Sday := '0' + Sday;
      MachineDate := smonth + sday + syear;
    end;

    Function DateFactor(MonthNum, DayNum, YearNum : Real) : Real;
    Var
     Factor : Real;
    begin
     Factor :=   (365 * YearNum)
               + DayNum
               + (31 * (MonthNum-1));
     if MonthNum < 3
      then Factor :=  Factor
                    + Int((YearNum-1) / 4)
                    - Int(0.75 * (Int((YearNum-1) / 100) + 1))
      else Factor :=  Factor
                    - Int(0.4 * MonthNum + 2.3)
                    + Int(YearNum / 4)
                    - Int(0.75 * (Int(YearNum / 100) + 1));
     DateFactor := Factor;
    end;

    Function DatetoJulian(DateLine : Str8) : Integer;
    Var
     Factor, MonthNum, DayNum, YearNum : Real;
     Ti : Integer;
    begin
     if Length(DateLine) = 7
      then DateLine := '0'+DateLine;
     MonthNum := 0.0;
     For Ti := 1 to 2 Do
      MonthNum := (10 * MonthNum)
        + (ord(DateLine[Ti])-ord('0'));
     DayNum := 0.0;
     For Ti := 3 to 4 Do
      DayNum := (10 * DayNum)
        + (ord(DateLine[Ti])-ord('0'));
     YearNum := 0.0;
     For Ti := 5 to 8 Do
      YearNum := (10 * YearNum)
        + (ord(DateLine[Ti])-ord('0'));
     Factor := DateFactor(MonthNum, DayNum, YearNum);
     DatetoJulian :=
      Trunc((Factor - 679351.0) - 32767.0);
    end;

    Function JuliantoDate(DateInt : Integer): Str11;
    Var
     holdstr  : String[2];
     anystr  : String[11];
     StrMonth : String[3];
     strDay   : String[2];
     stryear  : String[4];
     test,
     error,
     Year,
     Dummy,
     I       : Integer;
     Save,Temp    : Real;
     JuliantoanyString : Str11;
    begin
     holdstr := '';
     JuliantoanyString := '00000000000';
     Temp  := Int(DateInt) + 32767 + 679351.0;
     Save  := Temp;
     Dummy := Trunc(Temp/365.5);
     While Save >= DateFactor(1.0,1.0,Dummy+0.0)
      Do Dummy := Succ(Dummy);
     Dummy := Pred(Dummy);
     Year  := Dummy;
     (* Determine number of Days into current year *)
     Temp  := 1.0 + Save - DateFactor(1.0,1.0,Year+0.0);
     (* Put the Year into the output String *)
     For I := 8 downto 5 Do
      begin
       JuliantoanyString[I]
        := Char((Dummy mod 10)+ord('0'));
       Dummy := Dummy div 10;
      end;
     Dummy := 1 + Trunc(Temp/31.5);
     While Save >= DateFactor(Dummy+0.0,1.0,Year+0.0)
      Do Dummy := Succ(Dummy);
     Dummy := Pred(Dummy);
     Temp  := 1.0 + Save - DateFactor(Dummy+0.0,1.0,Year+0.0);
     For I := 2 Downto 1 Do
      begin
       JuliantoanyString[I]
        := Char((Dummy mod 10)+ord('0'));
       Dummy := Dummy div 10;
      end;
     Dummy := Trunc(Temp);
     For I := 4 Downto 3 Do
      begin
       JuliantoanyString[I]
        := Char((Dummy mod 10)+ord('0'));
       Dummy := Dummy div 10;
      end;
      holdstr := copy(juliantoanyString,1,2);
      val(holdstr,test,error);
      Case test of
        1 : StrMonth := 'Jan';
        2 : StrMonth := 'Feb';
        3 : StrMonth := 'Mar';
        4 : StrMonth := 'Apr';
        5 : StrMonth := 'May';
        6 : StrMonth := 'Jun';
        7 : StrMonth := 'Jul';
        8 : StrMonth := 'Aug';
        9 : StrMonth := 'Sep';
       10 : StrMonth := 'Oct';
       11 : StrMonth := 'Nov';
       12 : StrMonth := 'Dec';
      end;
      stryear := copy(juliantoanyString,5,4);
      strDay  := copy(juliantoanyString,3,2);
      anystr := StrDay + '-' + StrMonth + '-' +stryear;
     JuliantoDate := anystr;
    end;

    Function JuliantoStr8(DateInt : Integer): Str8;
    Var
     holdstr  : String[2]; anystr   : String[8]; StrMonth : String[2];
     strDay   : String[2]; stryear  : String[4]; Save, Temp : Real;
     test, error, Year, Dummy, I : Integer; JuliantoanyString : Str8;
    begin
     holdstr := ''; JuliantoanyString := '00000000';
     Temp  := Int(DateInt) + 32767 + 679351.0;
     Save  := Temp; Dummy := Trunc(Temp/365.5);
     While Save >= DateFactor(1.0,1.0,Dummy+0.0) Do Dummy := Succ(Dummy);
     Dummy := Pred(Dummy); Year  := Dummy;
     Temp  := 1.0 + Save - DateFactor(1.0,1.0,Year+0.0);
     For I := 8 downto 5 Do
      begin
       JuliantoanyString[I] := Char((Dummy mod 10)+ord('0'));
       Dummy := Dummy div 10;
      end;
     Dummy := 1 + Trunc(Temp/31.5);
     While Save >= DateFactor(Dummy+0.0,1.0,Year+0.0) Do Dummy := Succ(Dummy);
     Dummy := Pred(Dummy);
     Temp  := 1.0 + Save - DateFactor(Dummy+0.0,1.0,Year+0.0);
     For I := 2 Downto 1 Do
      begin
       JuliantoanyString[I] := Char((Dummy mod 10)+ord('0'));
       Dummy := Dummy div 10;
      end;
     Dummy := Trunc(Temp);
     For I := 4 Downto 3 Do
      begin
       JuliantoanyString[I] := Char((Dummy mod 10)+ord('0'));
       Dummy := Dummy div 10;
      end;
      holdstr := copy(juliantoanyString,1,2); val(holdstr,test,error);
      Case test of
      1 : StrMonth := '01'; 2 : StrMonth := '02'; 3 : StrMonth := '03';
      4 : StrMonth := '04'; 5 : StrMonth := '05'; 6 : StrMonth := '06';
      7 : StrMonth := '07'; 8 : StrMonth := '08'; 9 : StrMonth := '09';
     10 : StrMonth := '10'; 11 : StrMonth := '11'; 12 : StrMonth := '12';
      end;
      StrYear := copy(juliantoanyString,5,4);
      StrDay  := copy(juliantoanyString,3,2);
      AnyStr := StrMonth + StrDay + StrYear; JuliantoStr8 := AnyStr;
    end;

    Function DayofWeek(Jdate : Integer) : Str3;
    begin
      Case jdate MOD 7 of
       0:DayofWeek:='Sun'; 1:DayofWeek:='Mon'; 2:DayofWeek := 'Tue';
       3:DayofWeek:='Wed'; 4:DayofWeek:='Thu'; 5:DayofWeek := 'Fri';
       6:DayofWeek:='Sat';
      end;
    end;

    Procedure DateDiff(Date1,Date2 : Integer;
               Var Date_Difference : Str9);
    Var
     Temp,Rdate1,Rdate2,Diff1 : Real;      Diff : Integer;
     Return                   : String[9]; Hold : String[3];
    begin
      Rdate2 := Date2 + 32767.5; Rdate1 := Date1 + 32767.5;
      Diff1  := Rdate1 - Rdate2; Temp   := Diff1;
      if Diff1 < 32 then (* determine number of Days *)
      begin
        Diff := Round(Diff1); Str(Diff,Hold);
        Return := Hold + ' ' + 'Day';
        if Diff > 1 then Return := Return + 's  ';
      end;
      if ((Diff1 > 31) and (Diff1 < 366)) then
      begin
        Diff1 := Diff1 / 30; Diff := Round(Diff1); Str(Diff,Hold);
        Return := Hold + ' ' + 'Month';
        if Diff > 1 then Return := Return + 's';
      end;
      if Diff1 > 365 then
      begin
        Diff1 := Diff1 / 365; Diff := Round(Diff1); Str(Diff,Hold);
        Return := Hold;
      end;
      Date_Difference := Return; Diff := Round(Diff1);
    end;
    end.

[Back to DATETIME SWAG index] [Back to Main SWAG index] [Original]