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

    {Does anyone have any code that takes a minutes figure away from the date
    and time ?
    The following should do the trick.  note that it Uses a non-TP-standard
    date/time Record structure, but you could modify it if you wanted to.

    ------------------------------------------------------------------------------
    }

    Unit timeadj;

    Interface

    Type

    timtyp  = Record             {time Record}
                hour  : Byte;
                min   : Byte;
              end;

    dattyp  = Record             {date Record}
                year : Integer;
                mon  : Byte;
                day  : Byte;
                dayno: Byte;
              end;

    dttyp   = Record             {date time Record}
                time : timtyp;
                date : dattyp;
              end;

    Function adjtime(od : dttyp ; nmins : Integer ; Var nd : dttyp) : Boolean;
                {add/subtract nmins to od to give nd}
                {return T if day change}

    Implementation

    {Date/Julian Day conversion routines
     Valid from 1582 onwards
     from James Miller G3RUH, Cambridge, England}

    Const
    {days in a month}
    monthd  : Array [1..12] of Byte = (31,28,31,30,31,30,31,31,30,31,30,31);

    d0 : LongInt = -428; {James defines this as the general day number}

    Procedure date2jul(Var dn : LongInt ; dat : dattyp);
    {calc julian date DN from date DAT}
    Var
    m : Byte;

    begin
      With dat do
        begin
          m := mon;
          if m <= 2 then
            begin
              m := m + 12;
              dec(year);
            end;
          dn := d0 + day + trunc(30.61 * (m + 1)) + trunc(365.25 * year) +
          {the next line may be omitted if only used from Jan 1900 to Feb 2100}
                trunc(year / 400) - trunc(year / 100) + 15;
        end
    end; {date2jul}

    Procedure jul2date(dn : LongInt ; Var dat : dattyp);
    {calc date DAT from julian date DN}
    Var
    d : LongInt;

    begin
      With dat do
        begin
          d := dn - d0;
          dayno := (d + 5) mod 7;
          {the next line may be omitted if only used from Jan 1900 to Feb 2100}
          d := d + trunc( 0.75 * trunc(1.0 * (d + 36387) / 36524.25)) - 15;
          year := trunc((1.0 * d - 122.1) / 365.25);
          d := d - trunc(365.25 * year);
          mon := trunc(d / 30.61);
          day := d - trunc(30.61 * mon);
          dec(mon);
          if mon > 12 then
            begin
              mon := mon - 12;
              inc(year);
            end;
        end;
    end;  {jul2date}

    Function juld2date(jul : Word ; Var jd : dattyp) : Boolean;
    {convert julian day  to date}
    {ret T if no err}

    Var
    sum : Integer;
    j : LongInt;

    begin
      if jul > 366 then
        begin
          juld2date := False;
          Exit;
        end
      else
        juld2date := True;
      if (jd.year mod 4) = 0 then
        monthd[2] := 29
      else
        monthd[2] := 28;
      sum := 0;
      jd.mon := 0;
      Repeat
        inc(jd.mon);
        sum := sum + monthd[jd.mon];
      Until sum >= jul;
      sum := sum - monthd[jd.mon];
      jd.day := jul - sum;
      date2jul(j,jd);
      jul2date(j,jd);
    end; {juld2date}

    Procedure adjdate(od : dattyp ; ndays : Integer ; Var nd : dattyp);
                {add/subtract ndays to od to give nd}

    Var
    j : LongInt;

    begin
      date2jul(j,od);
      j := j + ndays;
      jul2date(j,nd);
    end;

    Function adjtime(od : dttyp ; nmins : Integer ; Var nd : dttyp) : Boolean;
                {add/subtract nmins to od to give nd}
                {return T if day change}
    Var
    emins : Integer;
    tnd   : dttyp; {needed in Case routine called With od & nd the same}

    begin
      adjtime := False;
      tnd := od;
      emins := od.time.hour*60 + od.time.min + nmins;
      if emins > 1439 then
        begin
          adjtime :=  True;
          emins := emins - 1440;
          adjdate(od.date,1,tnd.date);
        end;
      if emins < 0 then
        begin
          adjtime :=  True;
          emins := emins + 1440;
          adjdate(od.date,-1,tnd.date);
        end;
      tnd.time.hour := emins div 60;
      tnd.time.min  := emins mod 60;
      nd := tnd;
    end;   {adjtime}

    end.

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