Board index » delphi » HOW 2: Count days between two dates

HOW 2: Count days between two dates

How can I count the days between two dates in D-M-YYYY format?

Please post & mail

Thanks in advance...

 

Re:HOW 2: Count days between two dates


Quote
> How can I count the days between two dates in D-M-YYYY format?

   Use the information you have here to convert the date to an ordinal
form - Julian is probably best.  Then subtract using the ordinal values.  
Here's a TP/BP Unit which has the logic you might need:

Unit TCDate;                                 { Date Routines  970718 }
  { Author: Trevor J Carlsen  Released into the public domain }
  { Enhanced by: Michael R. Copeland }
interface
uses dos;
type  Date     = word;
Type HexByteType = String[2];
     HexWordType = String[4];

const WeekDays : array[0..6] of string[9] = ('Sunday','Monday','Tuesday',
                                             'Wednesday','Thursday',
                                             'Friday','Saturday');
      months   : array[1..12] of string[9] =
('January','February','March','April','May','June','July','August',
 'September','October','November','December');

function DayOfTheWeek(pd : date): byte;
 { Returns the day of the week for any date  Sunday = 0 .. Sat = 6    }
 { pd = a packed date as returned by the function PackedDate          }
 { eg...  writeln('Today is ',WeekDays[DayOfTheWeek(Today))];         }

function PackedDate(yr,mth,d: word): date;
 { Packs a date into a word which represents the number of days since }
 { Dec 31,1899   01-01-1900 = 1                                       }

procedure UnPackDate(VAR yr,mth,d: word; pd : date);
 { Unpacks a word returned by the function PackedDate into its        }
 { respective parts of year, month and day                            }

function DateStr(pd: date; format: byte): string;
 { Unpacks a word returned by the function PackedDate into its        }
 { respective parts of year, month and day and then returns a string  }
 { formatted according to the specifications required.                }
 { If the format is > 9 then the day of the week is prefixed to the   }
 { returned string.                                                   }
 { Formats supported are:                                             }
 {     0:  dd/mm/yy                                                   }
 {     1:  mm/dd/yy                                                   }
 {     2:  dd/mm/yyyy                                                 }
 {     3:  mm/dd/yyyy                                                 }
 {     4:  [d]d xxx yyyy   (xxx is alpha month of 3 chars)            }
 {     5:  xxx [d]d, yyyy                                             }
 {     6:  [d]d FullAlphaMth yyyy                                     }
 {     7:  FullAlphaMth [d]d, yyyy                                    }
 {     8:  [d]d-xxx-yy                                                }
 {     9:  xxx [d]d, 'yy                                              }

function ValidDate(yr,mth,d : word; VAR errorcode : byte): boolean;
 { Validates the date and time data to ensure no out of range errors  }
 { can occur and returns an error code to the calling procedure. A    }
 { errorcode of zero is returned if no invalid parameter is detected. }
 { Errorcodes are as follows:                                         }

 {   Year out of range (< 1900 or > 2078) bit 0 of errorcode is set.  }
 {   Month < 1 or > 12                    bit 1 of errorcode is set.  }
 {   Day < 1 or > 31                      bit 2 of errorcode is set.  }
 {   Day out of range for month           bit 2 of errorcode is set.  }

procedure ParseDateString(var dstr; var y,m,d : word; format : byte);
 { Parses a date string in several formats into its component parts   }
 { It is the programmer's responsibility to ensure that the string    }
 { being parsed is a valid date string in the format expected.        }
 { If the year string is of 2 characters then the year returned will  }
 { have 1900 added if > 50 and 2000 added if under 51.                }
 { Formats supported are:                                             }
 {     0:  dd/mm/yy[yy]                                               }
 {     1:  mm/dd/yy[yy]                                               }

function NumbOfDaysInMth(y,m : word): byte;
 { returns the number of days in any month                            }

function Today : date;
 { returns the number of days since 31-12-1899                        }

function OrdDate (Y,M,D : Word):LongInt; { returns Ordinal Date yyddd }
function DateOrd (S : string): string;     { returns Date as 'yymmdd' }
function CentYear (Y : Byte): Word; { returns Year, adjusted for 2000 }
function Date2Hex (PD : Date): string;  { returns ordinal date as Hex }
function Hex2Date (HD : string): Word;  { returns Hex date as ordinal }
function Hex2YMDS (HD : string): string; { returns Hex date as YYMMDD }

implementation
const TDays : array[Boolean,0..12] of word =
         ((0,31,59,90,120,151,181,212,243,273,304,334,365),
         (0,31,60,91,121,152,182,213,244,274,305,335,366));

function OrdDate (Y,M,D : Word): LongInt;     { Ordinal Date as yyddd }
var LYR  : boolean;
    Temp : LongInt;
begin
  LYR := (Y mod 4 = 0) and (Y <> 1900);
  if Y > 50 then Dec (Y,1900)
  else           Dec (Y,2000);
  Temp := LongInt(Y) * 1000;
  Inc (Temp,TDays[LYR][M-1]);     { compute # days through last month }
  Inc (Temp,D);                                   { # days this month }
  OrdDate := Temp
end;  { OrdDate }

function DateOrd (S : string) : string;    { returns Date as 'yymmdd' }
var LYR   : boolean;
    Y,M,D : Word;
    Temp  : LongInt;
    N     : integer;
    SW,ST : string[6];
begin
  Val (Copy(S,1,2),Y,N); Val (Copy(S,3,3),Temp,N);
  if Y > 74 then Inc(Y,1900)
  else           Inc(Y,2000);
  LYR := (Y mod 4 = 0) and (Y <> 1900); N := 0;
  while (TDays[LYR][N] < Temp) do
    Inc (N);
  M := N;                                                   { month }
  D := Temp-TDays[LYR][M-1];      { subtract # days thru this month }
  Str((Y mod 100):2,SW); Str(M:2,ST);
  if ST[1] = ' ' then ST[1] := '0'; SW := SW+ST;
  Str(D:2,ST);
  if ST[1] = ' ' then ST[1] := '0'; SW := SW+ST;
  DateOrd := SW
end;  { DateOrd }

function DayOfTheWeek(pd : date): byte;
begin
  DayOfTheWeek := pd mod 7
end;

function PackedDate(yr,mth,d : word): date;
                                   { valid for all years 1900 to 2078 }
var temp  : word;
    lyr   : boolean;
begin
  lyr   := (yr mod 4 = 0) and (yr <> 1900);
  Yr    := Yr mod 100; { dec(yr,1900); }
  temp  := yr * word(365) + (yr div 4) - ord(lyr);
  inc(temp,TDays[lyr][mth-1]); inc(temp,d);
  PackedDate := temp
end;  { PackedDate }

procedure UnPackDate(var yr,mth,d: word; pd : date);
                                  { valid for all years 1900 to 2078 }
var julian : word;
    lyr    : boolean;
begin
  d := pd; yr := (longint(d)*4) div 1461;
  julian := d-(yr*365+(yr div 4));
  if Yr > 74 then Inc(Yr,1900)
  else            Inc(Yr,2000);
  lyr    := (yr mod 4 = 0) and (yr <> 1900);
  inc(julian,ord(lyr)); mth := 0;
  while julian > TDays[lyr][mth] do
    inc(mth);
  d := julian-TDays[lyr][mth-1]
end; { UnPackDate }

function DateStr(pd: date; format: byte): string;
var y,m,d    : word;
    YrStr    : string[5];
    MthStr   : string[11];
    DayStr   : string[8];
    TempStr  : string[5];
begin
  UnpackDate(y,m,d,pd); str(y,YrStr); str(m,MthStr); str(d,DayStr);
  TempStr := '';
  if format > 9 then
    TempStr := copy(WeekDays[DayOfTheWeek(pd)],1,3) + ', ';
  if (format mod 10) < 4 then
    begin
      if m < 10 then MthStr := '0'+MthStr;
      if d < 10 then DayStr := '0'+DayStr
    end;
  case format mod 10 of  { force format to a valid value }
    0: DateStr := TempStr+DayStr+'/'+MthStr+'/'+copy(YrStr,3,2);
    1: DateStr := TempStr+MthStr+'/'+DayStr+'/'+copy(YrStr,3,2);
    2: DateStr := TempStr+DayStr+'/'+MthStr+'/'+YrStr;
    3: DateStr := TempStr+MthStr+'/'+DayStr+'/'+YrStr;
    4: DateStr := TempStr+DayStr+' '+copy(months[m],1,3)+' '+YrStr;
    5: DateStr := TempStr+copy(months[m],1,3)+' '+DayStr+' '+YrStr;
    6: DateStr := TempStr+DayStr+' '+months[m]+' '+YrStr;
    7: DateStr := TempStr+months[m]+' '+DayStr+' '+YrStr;
    8: DateStr := TempStr+DayStr+'-'+copy(months[m],1,3)+
                          '-'+copy(YrStr,3,2);
    9: DateStr := TempStr+copy(months[m],1,3)+
                          ' '+DayStr+','''+copy(YrStr,3,2);
  end;  { case }
end;  { DateStr }

function ValidDate(yr,mth,d : word; var errorcode : byte): boolean;
begin
  errorcode := 0;
  if (yr < 1900) or (yr > 2078) then errorcode := (errorcode or 1);
  if (d < 1) or (d > 31) then errorcode := (errorcode or 2);
  if (mth < 1) or (mth > 12) then errorcode := (errorcode or 4);
  case mth of
    4,6,9,11: if d > 30 then errorcode := (errorcode or 2);
           2: if d > (28+ord((yr mod 4) = 0)) then
                errorcode := (errorcode or 2);
  end; {case }
  ValidDate := (errorcode = 0);
  if errorcode <> 0 then write(#7)
end;

procedure ParseDateString(var dstr; var y,m,d : word; format : byte);
var left,middle       : word;
    errcode           : integer;
    st                : string absolute dstr;
begin
  val(copy(st,1,2),left,errcode); val(copy(st,4,2),middle,errcode);
  val(copy(st,7,4),y,errcode);
  if y < 1900 then
    if y < 51 then inc(y,2000)
    else           inc(y,1900);
  case format of
    0: begin
         d := left; m := middle
       end;
    1: begin
         d := middle; m := left
       end;
  end; { case }
end; { ParseDateString }

function NumbOfDaysInMth(y,m : word): byte;
  { valid for the years 1900 - 2078                                   }
begin
  case m of
    1,3,5,7,8,10,12: NumbOfDaysInMth := 31;
    4,6,9,11       : NumbOfDaysInMth := 30;
    2              : NumbOfDaysInMth := 28+ord((y mod 4) = 0)-
                                        ord(y = 1900);
  end;
end;

function Today : date;
var y,m,d,dw : word;
begin
  GetDate(y,m,d,dw); Today := PackedDate(y,m,d)
end;

function CentYear (Y : Byte): Word; { returns Year, adjusted for 2000 }
begin
  if Y > 50 then CentYear := 1900+Y
  else           CentYear := 2000+Y
end;  { CentYear }

Procedure ByteToHex(x ...

read more »

Re:HOW 2: Count days between two dates


I know of a function "DateDiff" in VB, maybe there is a comparable
function in Pascal.
--

Eric P. van Westendorp  Tel: +31(0252)210579
Reigerslaan 22  2215NN Voorhout  Netherlands

Quote
TMF wrote:

> How can I count the days between two dates in D-M-YYYY format?

> Please post & mail

> Thanks in advance...

Re:HOW 2: Count days between two dates


JRS:  In article <7hh0gu$3q...@zonnetje.NL.net> of Fri, 14 May 1999
13:12:30 in news:borland.public.turbopascal, TMF <t...@hotmail.com>
wrote:

Quote
>How can I count the days between two dates in D-M-YYYY format?

>Please post & mail

No.  QHAH.

The code you need is in
        http://www.merlyn.demon.co.uk/programs/dateprox.pas
and tested by
        http://www.merlyn.demon.co.uk/programs/mjd_date.pas
provided that the dates are Gregorian, Julian, or Civil, and lie within
about 32000BC to 32000AD.
For a wider date range (Gregorian only), longcalc.pas will do it.

You have posted to c.l.p, which was rmgrouped long ago.

--
 ? John Stockton, Surrey, UK.  j...@merlyn.demon.co.uk   Turnpike v4.00   MIME. ?
  Web <URL: http://www.merlyn.demon.co.uk/> - TP/BP/&c. FAQqish topics & links.
  Timo's TurboPascal <A HREF="ftp://garbo.uwasa.fi/pc/link/tsfaqp.zip">FAQ</A>.
  <A HREF="http://www.merlyn.demon.co.uk/clpb-faq.txt">Mini-FAQ</A> of c.l.p.b.

Re:HOW 2: Count days between two dates


Quote
On Fri, 14 May 1999 13:12:30 +0200, "TMF" <t...@hotmail.com> wrote:
>How can I count the days between two dates in D-M-YYYY format?

Make a Julian Date function.

Julian date = 1721028.5367 + D + 367*Y -7*(Y+(M+9)\12)\4
-3*((Y+(M-9)\7)\100+1)\4        + 275*M\9

Apply to both dates, and substract.
Manuel Algora
m...@encomix.es

Re:HOW 2: Count days between two dates


  57) How can I calculate the difference between two points of time?
 119) What is the Pascal code to add a number of days to a date?

 164988 Apr 25 1999 ftp://garbo.uwasa.fi/pc/link/tsfaqp.zip
 tsfaqp.zip Common Turbo Pascal Questions and Timo's answers, linked

   All the best, Timo

....................................................................
Prof. Timo Salmi   Co-moderator of news:comp.archives.msdos.announce
Moderating at ftp:// & http://garbo.uwasa.fi/ archives 193.166.120.5
Department of Accounting and Business Finance  ; University of Vaasa
mailto:t...@uwasa.fi <http://www.uwasa.fi/~ts/>  ; FIN-65101,  Finland

Spam foiling in effect.  My email filter autoresponder will return a
required email password to users not yet in the privileges database.
Advice on spam foiling at http://www.uwasa.fi/~ts/info/spamfoil.html

Other Threads