NetNews Usenet Archive 1993 #3/NN_1993_3.iso/spool/comp/lang/pascal/8582

Internet Message Format | 1993-01-28 | 4.8 KB

Path: sparky!uunet!tcsi.com!iat.holonet.net!news.cerf.net!usc!howland.reston.ans.net!spool.mu.edu!darwin.sura.net!sgiblab!munnari.oz.au!metro!grivel!metz.une.edu.au!ddavidso
From: [e-mail] (Dean Davidson)
Newsgroups: comp.lang.pascal
Subject: Re: Date/time manipulation
Keywords: dat,time
Message-ID: <[e-mail]>
Date: 26 Jan 93 22:03:18 GMT
References: <[e-mail]>
Sender: [e-mail]
Organization: University of New England, Armidale, Australia
Lines: 184

In article <[e-mail]> [e-mail] (Michael Currin) writes:
>Hi All
>
>I have a line of text that is generated by a package that we use that looks
>like :-
>
>  23/01/93, 00:01:31, 31, NAME OF SOMEONE
>
>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.

Good luck,
Dean

------------------------------------------------------------------------------

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.

-----------------------------------------------------------------------------

--
Dean Davidson                                 [e-mail]
Dept Psychology                               Phone [phone]
University of New England                     Fax   [phone]
Armidale NSW 2351 Australia                   VK2 ZID