Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Neuen Beitrag zur Code-Library hinzufügen (https://www.delphipraxis.net/33-neuen-beitrag-zur-code-library-hinzufuegen/)
-   -   Delphi Gregorianischer Tag - Gregorianisches Datum (https://www.delphipraxis.net/137305-gregorianischer-tag-gregorianisches-datum.html)

Wolfgang Mix 18. Jul 2009 11:36


Gregorianischer Tag - Gregorianisches Datum
 
Die häufigsten Kalenderfunktionen kommen mit dem gregorianischen Kalenderbereich aus.
Ich habe daher den 15.10.1582 als den gregorianischen Tag 1 definiert (ab 0 Uhr);
Gregor liefert die Tageszahl zu einem Datum, GregorToStr zu einer Tagesnummer
das Gregorianische Datum;
Ich freue mich wieder auf konstruktive Ergänzungen.

Aktualisierte Fassung hier

Delphi-Quellcode:
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;


function GregorToStr(n:longint):String;
begin
    if (n<1) or (n>3074324) then
       raise Exception.CreateFmt('GregorToStr(%d) - invalid n', [n])
    else
    begin
       n:=n-115859;
       result:=DatetimeToStr(n);
    end;
end;

Satty67 18. Jul 2009 12:02

Re: Gregorianischer Tag - Gregorianisches Datum
 
Macht (hoffentlich) nichts anderes, aber verändert nicht den Parameter und vergleicht im Fehlerfall nicht immer beide Werte:
Delphi-Quellcode:
function GregorToStr(n:longint):String;
begin
  if (n >= 1) and (n <= 3074324) then
    Result := DateTimeToStr(n - 115859)
  else
    raise Exception.CreateFmt('GregorToStr(%d) - invalid n', [n])
end;
Nicht wirklich eine Verbesserung, fand es aber so schöner :stupid:

€: Vielleicht kann jemand, der mehr Ahnung hat was zu schreiben... Parameter verändern legt eine weiter lokale Kopie an? Bringt const hier was um evtl Schleifendurchläufe zu verbessern?

Wolfgang Mix 18. Jul 2009 22:17

Re: Gregorianischer Tag - Gregorianisches Datum
 
Danke Satty67,

kann mich nach längerem Hinsehen mit deiner Ergänzung anfreunden.
Die If-Abfrage wirkt positiver, und mit der Parameteränderung hast du natürlich recht.
Die Ergebnisse sind natürlich identisch.

Wolfgang Mix 2. Aug 2009 16:52

Re: Gregorianischer Tag - Gregorianisches Datum
 
Habe die Funktion GregorToStr noch einmal vereinfacht.
Sie heißt jetzt GregorToDate und gibt jetzt statt einem String einen Datumswert zurück.

Delphi-Quellcode:
//Wolfgang Mix - Delphi-Praxis
//Returns date of a Gregorian day number; 1 = 1582-10-15; 152385 = 2000-1-1
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;


Label1.Caption:=DateToStr(GregorToDate(152385)); // 2000-01-01

Wolfgang Mix 23. Aug 2009 14:14

Re: Gregorianischer Tag - Gregorianisches Datum
 
Zur Ergänzung biete ich noch eine plattformunabhängige Variante, die ich aus fölgendem Link übersetzt habe:

http://mathforum.org/library/drmath/view/62338.html

Fehlerhafte Übergabewerte müßt Ihr dann je nach Programmiersprache selbst abfangen.

Gruß

Wolfgang

Delphi-Quellcode:
implementation

{$R *.dfm}

{Eingabe d,m,y
Ausgabe GD, 15.10.1582 gd = 1}
// Quelle: [url]http://mathforum.org/library/drmath/view/62338.html[/url]
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);


end;


procedure TForm1.Button1Click(Sender: TObject);
var d,m,y:integer;
begin
  d:=StrToInt(spinedit1.text);
  m:=StrToInt(spinedit2.text);
  y:=StrToInt(spinedit3.text);
  edit1.Text:= IntToStr(gd(d,m,y));
end;

end.


Alle Zeitangaben in WEZ +1. Es ist jetzt 13:15 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz