<div dir="ltr"><div class="gmail_extra"><div class="gmail_quote">2013/11/18 Jürgen Hestermann <span dir="ltr"><<a href="mailto:juergen.hestermann@gmx.de" target="_blank">juergen.hestermann@gmx.de</a>></span><br><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">
<br>
Am 2013-11-18 13:11, schrieb Frederic Da Vitoria:<div><br>
<blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">
First of all, I decided to use a different name. DateDiff comes from Excel, this is Lazarus, we should try to use names consistent with our functions. I chose DatesToAge, but I am not convinced this name is any better to any other name which has been used in this thread. I'll keep it here as this allows to distinguish my routine from others.<br>
</blockquote>
<br></div>
I still find "CalenderDiff" the best name for this function<br>
because it clearly states that differences are calculated for calender<br>
dates and not for an homogeneous stream of seconds/hours/days.</blockquote></div><br></div><div class="gmail_extra">Here are the latest (and I hope final) versions. I finally managed to reach correct results, even if the code is a bit clunky for my taste.<br>
<br></div>"DatesToAge" can be changed to "CalendarDiff" (or "WesternGregorianCalendarDiff" :-) ), I don't care, I have kept "DatesToAge" until now because I felt it made discussions about the different implementations clearer (one could easily miss the difference between "CalendarDiff" and "CalendarDateDiff")
<div class="gmail_extra"><br></div><div class="gmail_extra"><div class="gmail_extra">I have tried to give statistics of the
differences in results with waldo kitty's function, but the differences are too
wide, the version I fetched from this thread is obviously buggy. I'll try
again after updating from svn, but I can't do it here (at work), this
will have to wait until this evening.<br><br></div>//////////////////////////// uDateDiff.pas:</div><div class="gmail_extra"><br>unit uDateDiff;<br><br>{$mode objfpc}{$H+}<br><br>interface<br><br>uses<br> Classes, SysUtils, Forms, Controls, StdCtrls, DateUtils;<br>
<br>type<br><br> { TForm1 }<br><br> TForm1 = class(TForm)<br> Button1: TButton;<br> Memo1: TMemo;<br> procedure Button1Click(Sender: TObject);<br> private<br> { private declarations }<br> public<br> { public declarations }<br>
end;<br><br>var<br> Form1: TForm1;<br><br>implementation<br><br>{$R *.lfm}<br><br>// This function ensures that adding parts to a date is done in the correct order: years first, days last<br>// It is not called by DatesToAge, but is the reference used to check DatesToAge's results.<br>
function IncDate (const aDate : TDate ; const Years, Months, Days: integer) : TDate ;<br>begin { IncDate }<br> result := IncDay (IncMonth (IncYear (aDate, years), months), days)<br>end { IncDate } ;<br><br>// Gives the age in months between Date1 and Date2.<br>
// abs (Months) will always be <= 12<br>// abs (Days) will always be <= 31<br>// if Date1 < Date2, Years, Months and Day will all be >= 0<br>// if Date1 > Date2, Years, Months and Day will all be <= 0<br>
procedure DatesToAge (Date1, Date2 : TDate ; out Years, Months, Days : integer) ;<br>var<br> day1, day2, year1, year2, month1, month2 : word ;<br> work_year, work_month, work_day : word ; // work date for intermediate calculations<br>
procedure ProcessPositive ;<br> var<br> month2_after_carry : integer ;<br> begin {ProcessPositive}<br> if day2 >= day1<br> then month2_after_carry := month2<br> else month2_after_carry := month2 - 1 ;<br>
if month2_after_carry >= month1<br> then begin<br> Years := year2 - year1 ;<br> Months := month2_after_carry - month1<br> end {then}<br> else begin<br> Years := year2 - year1 - 1 ;<br>
Months := month2_after_carry - month1 + 12<br> end {else} ;<br> if day2 >= day1<br> then Days := day2 - day1<br> else begin<br> DecodeDate (IncMonth (date2, -1), work_year, work_month, work_day) ;<br>
Days := day2 - day1 + DaysInAMonth (work_year, work_month)<br> end {else} ;<br> // now it's time to adjust the dates<br> while IncDate (date1, Years, Months, Days) < Date2 do Inc (Days) ;<br> while IncDate (date1, Years, Months, Days) > Date2 do Dec (Days) ;<br>
if Days >= 28<br> then begin // check if result can be optimized<br> if Months >= 11<br> then begin<br> work_year := Years + 1 ;<br> work_month := Months + 1 - 12<br> end {then}<br>
else begin<br> work_year := Years ;<br> work_month := Months + 1<br> end {else} ;<br> if IncDate (date1, work_year, work_month, 0) <= Date2<br> then begin // ok, it works<br>
Years := work_year;<br> Months := work_month ;<br> Days := 0 ;<br> while IncDate (date1, Years, Months, Days) < Date2 do Inc (Days)<br> end {then}<br> end {then}<br>
end {ProcessPositive} ;<br> procedure ProcessNegative ; // date2 < date1: result will be negative. Completely different algorithm from ProcessPositive<br> begin {ProcessNegative}<br> Years := year2 - year1 ;<br>
Months := month2 - month1 ;<br> if Months < -12<br> then begin<br> Dec (Years) ;<br> Inc (Months, 12)<br> end {then}<br> else if Months > 0<br> then begin<br> Inc (Years) ;<br>
Dec (Months, 12)<br> end {then} ;<br> Days := day2 - day1 ;<br> if Days > 0<br> then begin<br> Inc (Months) ;<br> if Months > 0<br> then begin<br> Inc (Years) ;<br>
Dec (Months, 12)<br> end {then} ;<br> Dec (Days, 30) // approximate value, will be adjusted later<br> end {then} ;<br> // now it's time to adjust the dates<br> while IncDate (date1, Years, Months, Days) < Date2 do Inc (Days) ;<br>
if Days > 0<br> then begin<br> Inc (Months) ;<br> if Months > 0<br> then begin<br> Inc (Years) ;<br> Dec (Months, 12)<br> end {then} ;<br> Dec (Days, 28) // approximate value, will be adjusted later<br>
end {then} ;<br> while IncDate (date1, Years, Months, Days) > Date2 do Dec (Days) ;<br> if IncDate (date1, Years, Months, 0) = DaysInAMonth (year1+Years, month1+Months)<br> then begin<br> Days := day1 - DaysInAMonth (year1+Years, month1+Months) ;<br>
if Months = 12<br> then begin<br> Inc (Years) ;<br> Months := 1<br> end {then}<br> else Inc (Months)<br> end {then}<br> end {ProcessNegative} ;<br>begin {DatesToAge}<br>
Days := 0;<br> Months := 0 ;<br> Years := 0 ;<br> DecodeDate (date1, year1, month1, day1) ;<br> DecodeDate (date2, year2, month2, day2) ;<br> if date1 <= date2<br> then ProcessPositive<br> else ProcessNegative<br>
end {DatesToAge} ;<br><br>{ TForm1 }<br><br>procedure TForm1.Button1Click(Sender: TObject);<br>var<br> years, months, days: integer; // result of the DatesToAge procedure<br> day_count_1, day_count_2: integer ;<br> date1, date2, date3 : TDate ;<br>
test_ok : boolean ;<br>begin<br> Memo1.Clear ;<br> Memo1.Append ('Running...');<br> test_ok := TRUE ;<br> for day_count_1 := 0 to DaysBetween (EncodeDate (2000, 01, 01), EncodeDate (2005, 12, 31)) do begin<br>
date1 := EncodeDate (2000, 01, 01) + day_count_1 ;<br> for day_count_2 := -(365*5) to (365*5) do begin<br> date2 := IncDay (date1, day_count_2) ;<br> DatesToAge(date1, date2, years, months, days) ;<br>
date3 := IncDate (date1, years, months, days) ;<br> if (date3 <> date2)<br> or (abs (days) > 31)<br> or (abs (months) > 11)<br> or ((date2 > date1) and ((years < 0) or (months < 0) or (days < 0)))<br>
or ((date2 < date1) and ((years > 0) or (months > 0) or (days > 0)))<br> then begin<br> test_ok := FALSE ;<br> Memo1.Append ('------'+DateToStr (date1)+' '+DateToStr (date2)+' Y='+IntToStr (years)+' M='+IntToStr (months)+' D='+IntToStr (days)+' '+DateToStr (date3));<br>
Memo1.Append ('IncYear='+DateToStr (IncYear (date1, Years))+', IncMonth+IncYear='+DateToStr (IncMonth (IncYear (date1, years), months)));<br> Memo1.Append ('IncMonth+IncYear='+DateToStr (IncMonth (IncYear (date1, 3), 12)));<br>
exit<br> end {then} ;<br> end {for}<br> end {for} ;<br> if test_ok<br> then Memo1.Append('Finished OK')<br> else Memo1.Append('Finished KO');<br>end;<br><br>end {uDateDiff}.<br>
<br><br><div class="gmail_extra">//////////////////////////// uDateDiff.lfm:</div>
<br>object Form1: TForm1<br> Left = 1322<br> Height = 277<br> Top = 35<br> Width = 584<br> Caption = 'Form1'<br> ClientHeight = 277<br> ClientWidth = 584<br> LCLVersion = '1.2.0.1'<br> object Button1: TButton<br>
Left = 8<br> Height = 25<br> Top = 8<br> Width = 75<br> Caption = 'Button1'<br> OnClick = Button1Click<br> TabOrder = 0<br> end<br> object Memo1: TMemo<br> Left = 88<br> Height = 259<br>
Top = 8<br> Width = 489<br> Anchors = [akTop, akLeft, akRight, akBottom]<br> ScrollBars = ssAutoBoth<br> TabOrder = 1<br> end<br>end<br></div><div class="gmail_extra"><br>-- <br>Frederic Da Vitoria<br>(davitof)<br>
<br>Membre de l'April - « promouvoir et défendre le logiciel libre » - <a href="http://www.april.org" target="_blank">http://www.april.org</a><br>
</div></div>