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

    {
    VINCE LAURENT

    > Does anyone have a fast function for sorting two dates?
    > Something like function SortDate(Date1, Date2 : string): integer;
    > Strings would be in the format of '1/1/94' etc.

    Convert the dates to Julian Dates first...then you can do with them
    what you want.  Here is a unit I got a long time ago...
    }

    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,
      strDay   : string[2];
      anystr   : string[11];
      StrMonth : string[3];
      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,
      StrMonth,
      strDay   : string[2];
      anystr   : string[8];
      stryear  : string[4];
      test,
      error,
      Year,
      Dummy,
      I       : Integer;
      Save,
      Temp    : Real;
      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;
      (* 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 := '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]