(Co-Admin)
Registriert seit: 30. Mai 2002
Ort: Hamburg
13.920 Beiträge
Delphi 10.4 Sydney
|
DateUtils, weitere Funktionen
8. Okt 2009, 11:13
Wolfgang Mix hat eine Bibliothek mit Datumsfunktionen entwickelt, welche die Funktionalität der mit Delphi ausgelieferten Bibliothek "DateUtils" deutlich erweitert:
Zuerst eine Übersicht der Funktionen von DateUtils2 , danach folgt der Quellcode der Unit und anschließend noch einige Beispiele, wie man die Funktionen aufrufen kann.
function AddDate(d,m,y:word;n:integer):TDate;
Addiert oder subtrahiert eine Anzahl von Tagen n und gibt das entsprechende Datum zurück.
function Age(BirthDate: TDate): integer;
Die Funktion ermittelt aus einem Geburtsdatum/Kaufdatum das Alter der Person/Sache.
Die Funktion ist schaltjahressicher.
function CalendarWeekToDate(cw,year:word): TDate;
Gibt aus Kalenderwoche und Jahr den Montag der Kalenderwoche als Datum zurück.
Falsche Übergabewerte werden abgefangen.
Diese Funktion benötigt FirstDayOfYear
function EasterSunday(year : integer) : TDate;
Ostersonntag fällt auf den nten März. Beispiel: EasterSunday=33 bedeutet 02.04.d.J.
Alle Rückgabewerte gelten für den grgorianischen Kalenderbereich
Entwickelt von C.F. Gauß im Jahr 1800. Gilt von 1583 bis 8202
Erster Fahler im Jahr 8202
function eastersunday_jul(year:integer):TDate;
Ostersonntag im julianischen Kalender (w.o)
function FirstDayOfMonth(month,year:word):TDate;
Gibt den Montag vor dem 1.des Monats oder den 1. des Monats selbst als Datum zurück.
function FirstDayOfYear(year:integer):TDate;
Gibt den Montag vor dem 1.1. oder den 1.1. selbst als Datum zurück.
function gd(d,m,y:real):longint;
Wie Gregor, aber plattformunabhängig
function Gregor(d,m,yyyy:word):longint;
Gibt den Integerwert eines Datums im Gregorianischen Kalender zurück.
Tag Nr. 1 ist der 15.10.1582, Nr. 152385 wäre der 1.1.2000
function GregorToDate(n:longint):Tdate;
Gibt zu einer Gregorianischen Tagesnummer das Datum zurück.
function Is53weeks1(y: word): boolean;
Gibt -1 (true) zurück, wenn das Jahr 53 Wochen hat, plattformunabhängig
function Is53weeks2(y: word): boolean;
wie oben, benötigt aber Delphi
function IsDateOk(d,m,y:word):boolean;
Gibt 0 (false) zurück, wenn das Datum fehlerhaft ist
function Isleapyear(year:integer):boolean;
Wie bei Delphi, aber der Gültigkeitsbereich ist 1.1.4713 v.Chr. bis 31.12.9999 n.Chr.
function JDOfAllDays(d,m,y:real):longint;
Gibt den Julianischen Tag eines Datums zurück.
Von 1.1.4713 v.Chr bis 4.10.1582 wird JDOfAllDays einem julianischen Datum zugeordnet,
ab 15.10.1582 einem gregorianischen. Die 10 Tage dazwischen fielen aus.
function JDOfGregorianDates(d,m,j:longint):longint;
Gibt den Julianischen Tag eines Datums im gregorianischen Kalenderbereich zurück.
function JDOfJulianDate(d,m,y:real):longint;
Gibt den Julianischen Tag eines Datums im julianischen Kalenderbereich zurück.
function JdToDate(jd:longint):TDate;
Gibt zur julianischen Tagesnummer ein Datum zurück. Vom 1.1.0001 bis 14.10.1582 wird
das Datum als julianisch interpretiert, danach als gregorianisch.
function JdToJuldatStr(jd:longint):String;
Gibt zur julianischen Tagesnummer ein julianisches Datum als String zurück,
weil Delphi mit negativen Jahreswerten nicht umgehen kann.
Jahr Nr. 0 wird als Jahr 1 v.Chr., Jahr 1 als Jahr 2 v.Chr interpetiert usw.
function JdToStr(jd:longint):String;
Wie JdToDate, aber auch für negative Jahreszahlen.
Jahr Nr. 0 wird als Jahr 1 v.Chr., Jahr 1 als Jahr 2 v.Chr interpetiert usw.
Gültigkeitsbereich 1.1.4713 v.Chr..31.12.9999
Bis 14.10.1582 wird das Datum als julianisch, danach als gregorianisch interpretiert.
function LastDayOfMonth(month,year:integer):TDate;
Gibt den Sonntag nach dem letzten Tag des Monats oder den letzten des Monats selbst
als Datum zurück.
function LastDayOfWeekOfMonth(year,month: Integer;DayOfWeek: TWeekDay):TDate;
Gibt z.B. den letzten Donnerstag im Monat zurück
function LastDayOfYear(year:integer):TDate;
Gibt den Sonntag nach Silvester oder aber Silvester selbst als Datum zurück.
Delphi-Quellcode:
unit Dateutils2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,DateUtils;
type TWeekDay = DayMonday..DaySunday;
function AddDate(d,m,y:word;n:integer):TDate;
function Age(BirthDate: TDate): integer;
function CalendarWeekToDate(cw,year:word): TDate;
function EasterSunday(year : integer) : TDate;
function eastersunday_jul(year:integer):TDate;
function FirstDayOfMonth(month,year:word):TDate;
function FirstDayOfYear(year:integer):TDate;
function gd(d,m,y:real):longint;
function Gregor(d,m,yyyy:word):longint;
function GregorToDate(n:longint):Tdate;
function Is53weeks1(y: word): boolean;
function Is53weeks2(y: word): boolean;
function IsDateOk(d,m,y:word):boolean;
function Isleapyear(year:integer):boolean;
function JDOfAllDays(d,m,y:real):longint;
function JDOfGregorianDates(d,m,j:longint):longint;
function JDOfJulianDate(d,m,y:real):longint;
function JdToDate(jd:longint):TDate;
function JdToJuldatStr(jd:longint): String;
function JdToStr(jd:longint): String;
function LastDayOfMonth(month,year:integer):TDate;
function LastDayOfWeekOfMonth(year,month: Integer;DayOfWeek: TWeekDay):TDate;
function LastDayOfYear(year:integer):TDate;
implementation
Delphi-Quellcode:
//Wolfgang Mix - Delphi-PRAXiS
//Add or subtract number of days and give back new date
function AddDate(d,m,y:word;n:integer):TDate;
begin
Result:=EncodeDate(y,m,d)+n;
end;
Delphi-Quellcode:
//Wolfgang Mix - Delphi-PRAXiS
//Returns age of a thing or person avoiding problems
//with leap years
function Age(BirthDate: TDate): integer;
var y1,y2,m1,m2,d1,d2: Word;
begin
SysUtils.DecodeDate(date,y1,m1,d1);
SysUtils.DecodeDate(BirthDate,y2,m2,d2);
Result := ((y1 * 10000 + m1 * 100 + d1)
- (y2 * 10000 + m2 * 100 + d2)) div 10000;
end;
Delphi-Quellcode:
//Returns the first day of calendar week as date
//Wolfgang Mix - Delphi-PRAXiS
// ----- Needs function FirstDayOfYear -----
//Returns the first day of calendar week as date
function CalendarWeekToDate(cw,year:word): TDate;
var temp1:TDate;
temp2:word;
begin
if (cw<=0) or (cw>WeeksInYear(year)) then
raise Exception.CreateFmt(' Cw(%d) - invalid arg', [cw]);
temp1:=FirstDayOfYear(year);
temp2:=WeekOfTheYear(temp1);
if temp2 = 1 then result:=7*(cw-1)+temp1
else result:=7*cw+temp1;
end;
Delphi-Quellcode:
function eastersunday(year : integer) : TDate;
//Wolfgang Mix - Delphi-PRAXiS
{ Easter is on march nth. Example: Easter=33 means 2nd of April
[url]http://matheplanet.com/default3.html?article=417[/url]
By formula of in the year 1800. For Dates from 1583 to 8202
1st failure Fehler in the year 8202
Modified by Wolfgang Mix}
var a,b,c,d,e,f,g,h,i,j,m,temp : integer;
begin
a := year mod 19;
b := year mod 4;
c := year mod 7;
d := ( ( (year div 100) * 8 ) + 13 ) div 25 - 2;
e := (year div 100) - (year div 400) - 2;
f := (15 + e - d) mod 30;
g := (6 + e) mod 7;
h := (19 * a + f) mod 30;
i := h;
if (h = 29) then i := 28;
if ( (h = 28) and (a > 10) ) then i := 27;
j := ( (2 * b) + (4 * c) + (6 * i) + g ) mod 7;
temp := + i + j + 22; {der nte Maerz}
if temp>31 then
begin
d:=temp-31;m:=4;
end
else
begin
d:=temp;m:=3;
end;
result:=EncodeDate(year,m,d);
end;
Delphi-Quellcode:
//Wolfgang Mix - Delphi-PRAXiS
{Easter is on march nth. Example: Easter=33 means 2nd of April
[url]http://matheplanet.com/default3.html?article=417[/url]
By formula of in the year 1800. For Dates from 1583 to 8202
1st failure Fehler in 8202
Modified by Wolfgang Mix}
function eastersunday_jul(year:integer):TDate;
var a,b,c,d,e,f,m,n,day,month:Integer;
begin
m:= 15;n:=6;
a := year mod 19;
b := year mod 4;
c := year mod 7;
d := (19*a+m) mod 30;
e := (2*b + 4*c + 6*d + n) mod 7;
f := 22+d+e;
//Easter met on (22+d+e)t Murch
//Correction of Lichtenberg 1997
if f = 57 then f:=50;
if f = 56 then f:=49;
//Extract Date
if f>31 then
begin
day:=f-31;month:=4;
end
else
begin
day:=f;month:=3;
end;
result:=EncodeDate(year,month,day);
end;
Delphi-Quellcode:
//Wolfgang Mix - Delphi-PRAXiS
//Returns Monday before 1st of month or 1st itsself as date
function FirstDayOfMonth(month,year:word):TDate;
var mydate:TDate;temp:extended;
begin
Mydate:= EncodeDate(year,month,1);
temp:=DayOfTheWeek(mydate);
mydate:=mydate-temp+1;
result:=mydate;
end;
Delphi-Quellcode:
//Wolfgang Mix - Delphi-PRAXiS
//Returns Monday before NewYear or NewYear itsself as date
function FirstDayOfYear(year:integer):TDate;
var mydate: TDate;temp:extended;
begin
Mydate:= EncodeDate(year,1,1);
temp:=DayOfTheWeek(mydate);
mydate:= mydate-temp+1;
result:=mydate;
end;
Delphi-Quellcode:
//Modified by Wolfgang Mix - Delphi-PRAXiS
//1582-10-15 is gd = 1}
//Source: [url]http://mathforum.org/library/drmath/view/62338.html[/url]
//For all platforms
function gd(d,m,y:real):longint;
var a,b,temp:real;
begin
if (m=1) or (m=2) then
begin
y:=y-1;m:=m+13;
end
else m:=m+1;
a:=int(y/100);
b:=2 - a + int(a/4);
temp:=int(int(365.25 * y) +int(30.6001*m) + b + d + 1720995);
result:=trunc(temp)-2299160;
end;
Delphi-Quellcode:
//Wolfgang Mix - Delphi-PRAXiS
//Returns a Gregorian day number since 1582-10-15 =1; 2000-1-1 = 152385
//Only for Delphi
function Gregor(d,m,yyyy:word):longint;
var Tmp:TDateTime;
begin
Tmp:=EncodeDate(yyyy,m,d);
result:=1+Round(tmp-StrToDate(' 15.10.1582'));
if result<1 then raise Exception.CreateFmt(' Gregor(%d) - invalid date',
[result])
end;
Delphi-Quellcode:
//Wolfgang Mix - Delphi-PRAXiS
//Returns a date from gregorian day number
function GregorToDate(n:longint):Tdate;
begin
if (n >= 1) and (n <= 3074324) then
Result := n - 115859
else
raise Exception.CreateFmt(' GregorToDate(%d) - invalid n', [n])
end;
Delphi-Quellcode:
//Wolfgang Mix - Delphi-PRAXiS
function Is53weeks1(y: word): boolean;
begin
Result := (DayOfTheWeek(EncodeDate(y, 1 , 1)) = 4) or (DayOfTheWeek(EncodeDate(y, 12, 31)) = 4);
end;
Delphi-Quellcode:
//Wolfgang Mix - Delphi-PRAXiS
function Is53weeks2(y: word): boolean;
begin
Result := (WeeksInYear(EncodeDate(y,1,1)) = 53);
end;
Delphi-Quellcode:
//Wolfgang Mix - Delphi-PRAXiS
//Range 1.1.0001 .. 31.12.9999
function IsDateOk(d,m,y:word):boolean;
var mydate:TDateTime;
begin
result:=false;
mydate:=EncodeDate(y,m,d);
If TryEncodeDate(y,m,d,myDate) Then result:=true
end;
Delphi-Quellcode:
//Wolfgang Mix - Delphi-PRAXiS
//Before 1582-10-15 returning Julian values,
//else Gregorian values, year no.0 excluded
//-1 = true ; 0 = false
function Isleapyear(year:integer):boolean;
begin
result:=false;
case year of
-4713..-1 :result:=(year+1) mod 4=0;
1 .. 1582 :result:= year mod 4=0;
1583..9999:result:=(year mod 4 =0) and ((year mod 100 <> 0)
or (year mod 400=0));
//else raise Exception.Create('year out of range');
else raise Exception.CreateFmt(' IsLeapYear(%d) - invalid arg', [year]);
end;
end;
Delphi-Quellcode:
//Modified by Wolfgang Mix - Delphi-PRAXiS
//Output JD, 1.1.-4712 jd=0
//Source: [url]http://mathforum.org/library/drmath/view/62338.html[/url]
function JDOfAllDays(d,m,y:real):longint;
var a,b,temp:real;
begin
//if y<1 then y:=y+1;
if (m=1) or (m=2) then
begin
y:=y-1;m:=m+13;
end
else m:=m+1;
a:=int(y/100);
b:=2 - a + int(a/4);
temp:=int(int(365.25 * y) +int(30.6001*m) + b + d + 1720995);
if trunc(temp) < 2299161 then
temp:=int(int(365.25 * y) +int(30.6001*m) + d + 1720995);
if y<0 then
temp:=int(int(365.25 * y - 0.75) +int(30.6001*m) + d + 1720995);
result:=trunc(temp);
end;
Delphi-Quellcode:
// Translated to Delphi: Wolfgang Mix - Delphi-PRAXiS
// Only for gregorian Dates from 1582-10-15 and above
// From H.F. Fliegel and T.C. van Flandern
// Source: Helmut Herold: Übungen zur Programmiersprache C, Teil II S. 260
function JDOfGregorianDates(d,m,j:longint):longint;
var k,l:longint;
begin
result:=0;
if (j<1582) or (j>9999) then showmessage('Invalid Date') else
if (j=1582) and (m < 10) then showmessage('Invalid Date') else
if (j=1582) and (m = 10) and (d<15) then showmessage('Invalid Date') else
begin
K:=(m-14) div 12;
L:= J+K+4800;
result:= d-32075+1461*L div 4 + 367*(M-2-12*k) div 12
- 3*((L+100) div 100) div 4;
end;
end;
Delphi-Quellcode:
//Source: [url]http://mathforum.org/library/drmath/view/62338.html[/url]
//Translated by Wolfgang Mix - Delphi-PRAXiS
//Input d,m,y of Julian Date
//Output JD, 1.1.-4712 jd=0
//Continous Counting 1582-10-04 = 2299160, 1582-10-05 = 2299161
function JDOfJulianDate(d,m,y:real):longint;
var a,b,temp:real;
begin
//if y<1 then y:=y+1;
if (m=1) or (m=2) then
begin
y:=y-1;m:=m+13;
end
else m:=m+1;
a:=int(y/100);
b:=2 - a + int(a/4);
//temp:=int(int(365.25 * y) +int(30.6001*m) + b + d + 1720995);
//if trunc(temp) < 2299161 then
temp:=int(int(365.25 * y) +int(30.6001*m) + d + 1720995);
if y<0 then
temp:=int(int(365.25 * y - 0.75) +int(30.6001*m) + d + 1720995);
result:=trunc(temp);
end;
Delphi-Quellcode:
//Source: [url]http://mathforum.org/library/drmath/view/62338.html[/url]
//Translated by Wolfgang Mix - Delphi-PRAXiS
//Input d,m,y of Julian Date
//Input: JD (Julian day)
//Returns Julian Date up to 1582-10-14 , since 1582-10-15
//Julian date of grgorian values
function JdToDate(jd:longint):TDate;
var A,B,C,D,E,F,G,J,M,T,Z:real;
begin
if (jd<1721424) or (jd>5373484) then raise Exception.CreateFmt(' JdToDate(%d) - invalid argument', [jd]);
Z:=Int (JD + 0.5);
F:=Frac(JD + 0.5);
If Z < 2299161 Then A:=Z // < 15.10.1582
else
begin
g:= int((Z-1867216.25) / 36525.25);
a:=z+1+g-int(g/4);
end;
B := A+1524;
C := Int((B-122.1)/365.25);
D := int(365.25 * C);
E := Int((B-D)/30.6001);
T := B-D-int(30.6001*E) + F;
if(E<14) then
M := E-1
else
M := E-13;
if (M>2) then
J := C-4716
else
J := C-4715;
if j<1 then j:=j-1;
result:=EncodeDate(trunc(j),trunc(m),trunc(t));
end; //T.M.J = Calendar date of JD
Delphi-Quellcode:
//Source: [url]http://de.wikipedia.org/wiki/[/url]
//Translated by Wolfgang Mix - Delphi-PRAXiS
//Input: Julian Day Number
//Range -4713-01-01 .. 9999-12-31
//Return all values julian (strait counting)
function JdToJuldatStr(jd:longint): String;
var A,B,C,D,E,F,G,J,M,T,Z:real;
day,month,year:integer;
days,months,years: string;
s: string;
begin
s:=' '; // just to initialize
if (jd<0) or (jd>5373484) then raise Exception.CreateFmt(' JdToDate(%d) - invalid argument', [jd]);
Z:=Int (JD + 0.5);
F:=Frac(JD + 0.5);
A:=Z;
B := A+1524;
C := Int((B-122.1)/365.25);
D := int(365.25 * C);
E := Int((B-D)/30.6001);
T := B-D-int(30.6001*E) + F;
if(E<14) then
M := E-1
else
M := E-13;
if (M>2) then
J := C-4716
else
J := C-4715;
if j<1 then j:=j-1;
//Develop String
day:=trunc(t);month:=trunc(m);year:=trunc(j);
Result := Format(' %.2d.%.2d.%d',[day,month,year]);
end; //T.M.J = Calendar Date of JD
Delphi-Quellcode:
// Source: [url]http://de.wikipedia.org/wiki/[/url]
// Tranlated by Wolfgang Mix - Delphi-PRAXiS
// Calculate Julian Date from Julian Day
// Range -4713-01-01 .. 9999-12-31
// Input: JD (Julian Day)
// Returns julian values up to 1582-10-04 then grgorian values
// from 1582-10-15 and later
function JdToStr(jd:longint): String;
var A,B,C,D,E,F,G,J,M,T,Z:real;
day,month,year:integer;
days,months,years: string;
s: string;
begin
s:=' '; // just to inatialize
if (jd<0) or (jd>5373484) then raise Exception.CreateFmt(' JdToDate(%d) - invalid argument', [jd]);
Z:=Int (JD + 0.5);
F:=Frac(JD + 0.5);
If Z < 2299161 Then A:=Z // < 15.10.1582
else
begin
g:= int((Z-1867216.25) / 36525.25);
a:=z+1+g-int(g/4);
end;
B := A+1524;
C := Int((B-122.1)/365.25);
D := int(365.25 * C);
E := Int((B-D)/30.6001);
T := B-D-int(30.6001*E) + F;
if(E<14) then
M := E-1
else
M := E-13;
if (M>2) then
J := C-4716
else
J := C-4715;
if j<1 then j:=j-1;
//Develope String
day:=trunc(t);month:=trunc(m);year:=trunc(j);
Result := Format(' %.2d.%.2d.%d',[day,month,year]);
end; //T.M.J = Calendar Date of JD
Delphi-Quellcode:
// Source: [url]http://www.mycsharp.de/wbb2/thread.php?threadid=74208[/url]
// Translated by DeddyH - Delphi-PRAXiS
// Useful. if you search for f.e. last thursday in August of 2009
function LastDayOfWeekOfMonth(year,month: Integer;DayOfWeek: TWeekDay):TDate;
var temp: TDate;
begin
temp := IncMonth(EncodeDateTime(year,month,1,0,0,0,0));
Result := IncDay(temp,(DayOfWeek - DayOfTheWeek(temp) + 7) mod 7 - 7);
end;
Delphi-Quellcode:
//Wolfgang Mix - Delphi-PRAXiS
//Returns Sunday after last daynumber of month
//or last daynumber itsself as date
function LastDayOfMonth(month,year:integer):TDate;
var mydate: TDate;temp:extended;
begin
Mydate:= EncodeDate(year,month,DaysInAMonth(year,month));
temp:=DayOfTheWeek(mydate);
mydate:= mydate+7-temp;
result:=mydate;
end;
Delphi-Quellcode:
//Wolfgang Mix - Delphi-PRAXiS
//Returns Sunday after Silvester or Silvester itsself as date
function LastDayOfYear(year:integer):TDate;
var mydate: TDate;temp:extended;
begin
Mydate:= EncodeDate(year,12,31);
temp:=DayOfTheWeek(mydate);
mydate:= mydate+7-temp;
result:=mydate;
end;
end.
Zum Schluss noch einige Beispiele, wie man die Funktionen aufrufen kann:
Edit1.Text:=DateToStr(AddDate(1,9,1009,-25)); ergibt 07.08.2009
gebdate:=EncodeDate(1950,1,25);
Edit1.Text:=IntToStr(age(gebdate)); ergibt 59 bei Systemdatum < 25.01.2010
Edit1.Text:=DateToStr(CalendarWeekToDate(40,2009)) ; ergibt 28.09.2009
Edit1.Text:=DateToStr(Eastersunday(2009)); ergibt 12.04.2009
Edit1.Text:=DateToStr(Eastersunday_jul(2009)); ergibt 06.04.2009
Edit1.Text:=DateToStr(FirstDayOfMonth(10,2009)); ergibt 28.09.2009
Edit1.Text:=DateToStr(FirstDayOfYear(2010)); ergibt 28.12.2009
Edit1.Text:=IntToStr(gd(15,10,1582)); ergibt 1
Edit1.Text:=IntToStr(gregor(15,10,1582)); ergibt 1
Edit1.Text:=DateToStr(GregorToDate(156000)); ergibt 24.11.2009
Edit1.Text:=BoolToStr(Is53Weeks1(2009)); ergibt -1 (true)
Edit1.Text:=BoolToStr(Is53Weeks2(2009)); ergibt -1 (true)
Edit1.Text:=BoolToStr(IsDateOk(30,2,2010)); ergibt 0 bei Datumfehler
Edit1.Text:=BoolToStr(Isleapyear(-4713)); ergibt -1 (true)
Edit1.Text:=IntToStr(JDOfAllDays(1,1,-4712)); ergibt 0
Edit1.Text:=IntToStr(JDOfAllDays(4,10,1582)); ergibt 2299160
Edit1.Text:=IntToStr(JDOfAllDays(15,10,1582)); ergibt 2299161
Edit1.Text:=IntToStr(JDOfGregorianDates(15,10,1582 )); ergibt 2299161
Edit1.Text:=IntToStr(JDOfJulianDate(15,10,1582)); 2299171
(Richtig, weil 10 Tage ausfielen)
Edit1.Text:=DateToStr(JdToDate(1725555)); ergibt 24.04.0012
(Delphi kann ab 1.1.0001)
Edit1.Text:=JdToJuldatStr(0); ergibt 01.01.-4713
Edit1.Text:=JdToStr(0); ergibt 01.01.-4713
Edit1.Text:=DateToStr(LastDayOfWeekOfMonth(2009,8, 4)); ergibt (Do) 27.08.2009 (Mo=1)
Edit1.Text:=DateToStr(LastDayOfMonth(9,2009)); ergibt 04.10.2009
Edit1.Text:=DateToStr(LastDayOfYear(2009)); ergibt 03.01.2010
Daniel R. Wolf
|