On 11/11/2013 6:54 PM, waldo kitty wrote:
On 11/11/2013 10:46 AM, John Landmesser wrote:
Fazit:
You can't write a DateDif function with the functions in DateUtils.pas ?!!
actually, you can but it is more brute-force for the results that you and i are
looking for... brute-force as in actually looping thru each unit and
incrementing a counter for that part to fill a record of some sort which is then
used to show the desired counts... i'm working on one as we speak ;)
it is amazing what refinements and streamlining will come up with at times...
originally this was totally brute force... then i started refining and cleaning
it up until i came up with this... it also includes a set of a set of dates for
testing...
===== snip =====
program DateDiff3;
uses
SysUtils,DateUtils,StrUtils;
type
Date_Diff = record
Years,
Months,
Days: Word;
end;
function CalendarDateDiff(Date1,Date2: TDateTime): Date_Diff;
var
theDiffRec: Date_Diff;
Cmp: Integer;
loDate,hiDate: TDateTime;
loYear,hiYear,loMonth,hiMonth,loDay,hiDay: Word;
begin
FillChar(theDiffRec,SizeOf(theDiffRec),0); // init results to zero
Cmp:=CompareDateTime(Date1,Date2); // compare dates
If Cmp<0 then
begin
loDate:= Date1; // and set loDate to oldest
hiDate:= Date2;
end
else if Cmp>0 then
begin
loDate:= Date2; // and set loDate to oldest
hiDate:= Date1;
end;
DecodeDate(loDate,loYear,loMonth,loDay);
DecodeDate(hiDate,hiYear,hiMonth,hiDay);
theDiffRec.Years:= hiYear - loYear;
if (loMonth > hiMonth) or ((loMonth = hiMonth) and (loDay > hiDay)) then
begin
theDiffRec.Years:= theDiffRec.Years - 1;
end;
if loMonth > hiMonth then
begin
hiMonth:= hiMonth + 12;
end;
theDiffRec.Months:= hiMonth - loMonth;
if hiDay >= loDay then
begin
theDiffRec.Days:= hiDay - loDay
end
else
begin
if theDiffRec.Months = 0 then
begin
theDiffRec.Months:= 11;
end
else
begin
theDiffRec.Months:= theDiffRec.Months - 1;
end;
theDiffRec.Days:= DaysInAMonth(hiYear,loMonth) - loDay + hiDay;
end;
Result:= theDiffRec;
end;
procedure Test(D1,D2: TDateTime);
var
DateDiffRec: Date_Diff;
begin
FillChar(DateDiffRec,SizeOf(DateDiffRec),0);
DateDiffRec:= CalendarDateDiff(D1,D2);
writeln(PadLeft(IntToStr(DateDiffRec.Years),4)+' yrs
'+PadLeft(IntToStr(DateDiffRec.Months),4)+' mos
'+PadLeft(IntToStr(DateDiffRec.Days),4)+' days');
end;
type
DateRecord = record
Year,
Month,
Day: Word;
end;
const
TstDates1: array[1..26] of DateRecord = (
(Year:2000;Month:01;Day:01),
(Year:2000;Month:01;Day:02),
(Year:2000;Month:01;Day:31),
(Year:2000;Month:02;Day:01),
(Year:2000;Month:02;Day:28),
(Year:2000;Month:02;Day:29),
(Year:2000;Month:03;Day:01),
(Year:2000;Month:03;Day:15),
(Year:2000;Month:12;Day:31),
(Year:2001;Month:01;Day:01),
(Year:2001;Month:01;Day:02),
(Year:2001;Month:02;Day:01),
(Year:2001;Month:02;Day:28),
(Year:2001;Month:02;Day:29),
(Year:2001;Month:03;Day:01),
(Year:2001;Month:03;Day:15),
(Year:2001;Month:08;Day:01),
(Year:2001;Month:12;Day:31),
(Year:2004;Month:01;Day:01),
(Year:2004;Month:01;Day:02),
(Year:2004;Month:02;Day:01),
(Year:2004;Month:02;Day:28),
(Year:2004;Month:02;Day:29),
(Year:2004;Month:03;Day:01),
(Year:2004;Month:03;Day:15),
(Year:2004;Month:12;Day:31)
);
TstDates2: Array[1..26] of DateRecord = (
(Year:2000;Month:01;Day:01),
(Year:2000;Month:01;Day:02),
(Year:2000;Month:01;Day:31),
(Year:2000;Month:02;Day:01),
(Year:2000;Month:02;Day:28),
(Year:2000;Month:02;Day:29),
(Year:2000;Month:03;Day:01),
(Year:2000;Month:03;Day:15),
(Year:2000;Month:12;Day:31),
(Year:2001;Month:01;Day:01),
(Year:2001;Month:01;Day:02),
(Year:2001;Month:02;Day:01),
(Year:2001;Month:02;Day:28),
(Year:2001;Month:02;Day:29),
(Year:2001;Month:03;Day:01),
(Year:2001;Month:03;Day:15),
(Year:2001;Month:08;Day:01),
(Year:2001;Month:12;Day:31),
(Year:2004;Month:01;Day:01),
(Year:2004;Month:01;Day:02),
(Year:2004;Month:02;Day:01),
(Year:2004;Month:02;Day:28),
(Year:2004;Month:02;Day:29),
(Year:2004;Month:03;Day:01),
(Year:2004;Month:03;Day:15),
(Year:2004;Month:12;Day:31)
);
var
DCnt1,DCnt2: Integer;
DT1,DT2: TDateTime;
DStr1,DStr2: String;
begin
writeln('TstDates1 has ',Length(TstDates1),' records');
writeln('TstDates2 has ',Length(TstDates2),' records');
for DCnt1:= 1 to Length(TstDates1) do
begin
if
IsValidDate(TstDates1[DCnt1].Year,TstDates1[DCnt1].Month,TstDates1[DCnt1].Day) then
begin
DT1:=
EncodeDate(TstDates1[DCnt1].Year,TstDates1[DCnt1].Month,TstDates1[DCnt1].Day);
DStr1:= FormatDateTime('YYYY-MM-DD',DT1);
for DCnt2:= 1 to Length(TstDates2) do
begin
if
IsValidDate(TstDates2[DCnt2].Year,TstDates2[DCnt2].Month,TstDates2[DCnt2].Day) then
begin
DT2:=
EncodeDate(TstDates2[DCnt2].Year,TstDates2[DCnt2].Month,TstDates2[DCnt2].Day);
DStr2:= FormatDateTime('YYYY-MM-DD',DT2);
write(DStr1+' to '+DStr2+' is ');
Test(DT1,DT2); // do the test
end
else
begin
writeln(DStr1+' to
'+PadLeft(IntToStr(TstDates2[DCnt2].Year),4)+'-'+AddChar('0',IntToStr(TstDates2[DCnt2].Month),2)+'-'+AddChar('0',IntToStr(TstDates2[DCnt2].Day),2)+'
invalid ending date');
end;
end;
end
else
begin
writeln(PadLeft(IntToStr(TstDates1[DCnt1].Year),4)+'-'+AddChar('0',IntToStr(TstDates1[DCnt1].Month),2)+'-'+AddChar('0',IntToStr(TstDates1[DCnt1].Day),2)+'
is an invalid starting date');
end;
writeln;
end;
end.
===== snip =====
--
NOTE: No off-list assistance is given without prior approval.
Please keep mailing list traffic on the list unless
private contact is specifically requested and granted.
--
_______________________________________________
Lazarus mailing list
[email protected]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
