home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / datetime.swg / 0016_TIME1.PAS.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  3.8 KB  |  166 lines
  1. {Does anyone have any code that takes a minutes figure away from the date
  2. and time ?
  3. The following should do the trick.  note that it Uses a non-TP-standard
  4. date/time Record structure, but you could modify it if you wanted to.
  5.  
  6. ------------------------------------------------------------------------------
  7. }
  8.  
  9. Unit timeadj;
  10.  
  11. Interface
  12.  
  13. Type
  14.  
  15. timtyp  = Record             {time Record}
  16.             hour  : Byte;
  17.             min   : Byte;
  18.           end;
  19.  
  20. dattyp  = Record             {date Record}
  21.             year : Integer;
  22.             mon  : Byte;
  23.             day  : Byte;
  24.             dayno: Byte;
  25.           end;
  26.  
  27. dttyp   = Record             {date time Record}
  28.             time : timtyp;
  29.             date : dattyp;
  30.           end;
  31.  
  32. Function adjtime(od : dttyp ; nmins : Integer ; Var nd : dttyp) : Boolean;
  33.             {add/subtract nmins to od to give nd}
  34.             {return T if day change}
  35.  
  36. Implementation
  37.  
  38. {Date/Julian Day conversion routines
  39.  Valid from 1582 onwards
  40.  from James Miller G3RUH, Cambridge, England}
  41.  
  42. Const
  43. {days in a month}
  44. monthd  : Array [1..12] of Byte = (31,28,31,30,31,30,31,31,30,31,30,31);
  45.  
  46. d0 : LongInt = -428; {James defines this as the general day number}
  47.  
  48. Procedure date2jul(Var dn : LongInt ; dat : dattyp);
  49. {calc julian date DN from date DAT}
  50. Var
  51. m : Byte;
  52.  
  53. begin
  54.   With dat do
  55.     begin
  56.       m := mon;
  57.       if m <= 2 then
  58.         begin
  59.           m := m + 12;
  60.           dec(year);
  61.         end;
  62.       dn := d0 + day + trunc(30.61 * (m + 1)) + trunc(365.25 * year) +
  63.       {the next line may be omitted if only used from Jan 1900 to Feb 2100}
  64.             trunc(year / 400) - trunc(year / 100) + 15;
  65.     end
  66. end; {date2jul}
  67.  
  68. Procedure jul2date(dn : LongInt ; Var dat : dattyp);
  69. {calc date DAT from julian date DN}
  70. Var
  71. d : LongInt;
  72.  
  73. begin
  74.   With dat do
  75.     begin
  76.       d := dn - d0;
  77.       dayno := (d + 5) mod 7;
  78.       {the next line may be omitted if only used from Jan 1900 to Feb 2100}
  79.       d := d + trunc( 0.75 * trunc(1.0 * (d + 36387) / 36524.25)) - 15;
  80.       year := trunc((1.0 * d - 122.1) / 365.25);
  81.       d := d - trunc(365.25 * year);
  82.       mon := trunc(d / 30.61);
  83.       day := d - trunc(30.61 * mon);
  84.       dec(mon);
  85.       if mon > 12 then
  86.         begin
  87.           mon := mon - 12;
  88.           inc(year);
  89.         end;
  90.     end;
  91. end;  {jul2date}
  92.  
  93. Function juld2date(jul : Word ; Var jd : dattyp) : Boolean;
  94. {convert julian day  to date}
  95. {ret T if no err}
  96.  
  97. Var
  98. sum : Integer;
  99. j : LongInt;
  100.  
  101. begin
  102.   if jul > 366 then
  103.     begin
  104.       juld2date := False;
  105.       Exit;
  106.     end
  107.   else
  108.     juld2date := True;
  109.   if (jd.year mod 4) = 0 then
  110.     monthd[2] := 29
  111.   else
  112.     monthd[2] := 28;
  113.   sum := 0;
  114.   jd.mon := 0;
  115.   Repeat
  116.     inc(jd.mon);
  117.     sum := sum + monthd[jd.mon];
  118.   Until sum >= jul;
  119.   sum := sum - monthd[jd.mon];
  120.   jd.day := jul - sum;
  121.   date2jul(j,jd);
  122.   jul2date(j,jd);
  123. end; {juld2date}
  124.  
  125. Procedure adjdate(od : dattyp ; ndays : Integer ; Var nd : dattyp);
  126.             {add/subtract ndays to od to give nd}
  127.  
  128. Var
  129. j : LongInt;
  130.  
  131. begin
  132.   date2jul(j,od);
  133.   j := j + ndays;
  134.   jul2date(j,nd);
  135. end;
  136.  
  137. Function adjtime(od : dttyp ; nmins : Integer ; Var nd : dttyp) : Boolean;
  138.             {add/subtract nmins to od to give nd}
  139.             {return T if day change}
  140. Var
  141. emins : Integer;
  142. tnd   : dttyp; {needed in Case routine called With od & nd the same}
  143.  
  144. begin
  145.   adjtime := False;
  146.   tnd := od;
  147.   emins := od.time.hour*60 + od.time.min + nmins;
  148.   if emins > 1439 then
  149.     begin
  150.       adjtime :=  True;
  151.       emins := emins - 1440;
  152.       adjdate(od.date,1,tnd.date);
  153.     end;
  154.   if emins < 0 then
  155.     begin
  156.       adjtime :=  True;
  157.       emins := emins + 1440;
  158.       adjdate(od.date,-1,tnd.date);
  159.     end;
  160.   tnd.time.hour := emins div 60;
  161.   tnd.time.min  := emins mod 60;
  162.   nd := tnd;
  163. end;   {adjtime}
  164.  
  165. end.
  166.