![]() |
DateUtils, weitere Funktionen
Liste der Anhänge anzeigen (Anzahl: 2)
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 |
Alle Zeitangaben in WEZ +1. Es ist jetzt 23:40 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz