![]() |
AW: Kalenderwoche ermitteln
Gerade mit Delphi 7 geschrieben:
Delphi-Quellcode:
uses DateUtils;
procedure CalculateNewWeekOfYear(WeekIn, YearIn, Offset: integer; out WeekOut, YearOut: integer); var DateValue: TDateTime; begin DateValue:= IncWeek(StartOfAWeek(YearIn, WeekIn), Offset); WeekOut := WeekOfTheYear(DateValue); YearOut := YearOf(DateValue); end; procedure TForm1.Button1Click(Sender: TObject); var OldYear, OldWeek, NewYear, NewWeek, Offset: integer; begin OldWeek := StrToInt(Edit1.Text); OldYear := StrToInt(Edit2.Text); Offset := StrToInt(Edit3.Text); CalculateNewWeekOfYear(OldWeek, OldYear, Offset, NewWeek, NewYear); Edit4.Text := IntToStr(NewWeek); Edit5.Text := IntToStr(NewYear); end; |
AW: Kalenderwoche ermitteln
Hallo,
bist Du damit zufrieden? ;-)
Delphi-Quellcode:
In die Uses-Klausel
procedure TForm1.Button1Click(Sender: TObject);
var dt : TDateTime; dw : Integer; begin dt := StrToDate('01.01.' + edYear.Text); dw := DayOfWeek(dt); if dw < 5 then dw := 7 else dw := 0; dt := dt + (StrToInt(edCW1.Text) + StrToInt(edWochen.Text)) * 7 - dw; edCW2.Text := IntToStr(WeekOfTheYear(dt)); edYear2.Text := IntToStr(YearOf(dt)); end;
Delphi-Quellcode:
mit aufnehmen, dann dürften auch
DateUtils
Delphi-Quellcode:
und
WeekOfTheYear
Delphi-Quellcode:
funktionieren.
YearOf
|
AW: Kalenderwoche ermitteln
Die Uses-Klausel an der richtigen Stelle habe ich bereits eingebaut (dank diesem Forum !).
Jetzt sieht es schon etwas besser aus, ist aber immer noch fehlerbehaftet, weil die Funktion YearOf(dt) zwar das richtige Jahr zum Datum liefert, dieses Jahr gehört aber nicht zur Woche. Test: Woche 52/2013 + 1 Woche => ergibt als Datum den 30.12.2013 (ist ok) und als Woche 01 (auch ok) aber als Jahr 2013, das ist falsch, es muss ja die Woche 01/2014 sein. Es müsste also eine Funktion JAHR-ZUM-DATUM(dt) und JAHR-ZUR-WOCHE(dt) geben. Evtl kann man das lösen, indem man abfragt, ob die Woche-Neu kleiner als die Woche-alt ist und in diesem Fall zum JAHR-NEU eine 1 dazu addieren, aber nur dann, wenn der Monat des Datums-Woche-neu eine 12 ist. Das klappt aber auch nicht immer, z.B. Test: Woche 52/2003 + 1 Woche = 31.12.2003 (ein Mittwoch), der 1.1.2004=Donnerstag, demnach beginnt Woche 1/2004. Es wird statt 01/2004 das Ergebnis 01/2003 geliefert. Also für das richtige Jahr zur Woche bei Jahreswechselüberschreitung muss man noch eine 100%ige Lösung finden. Die vorhandenen Funktionen liefern das für Deutschland nicht. In den USA, wo immer die Woche 1 mit dem 01.01. beginnt, stimmt das vielleicht. Obwohl das Beispiel 2003/2004 zeigt, dass es nicht stimmt.
Delphi-Quellcode:
@DeddyH, ich habe Deine Version probiert, auch damit wird z.B. bei 52/2003 + 1 Wo = 01/2003 ermittelt, statt 1/2004 - also die gleiche Jahreswechselproblematik.
procedure TForm1.Button2Click(Sender: TObject);
var dt : TDateTime; iYear2,iWeek1,iWeek2,iMon2 : Integer; begin iWeek1 := StrToInt(ComboBox1.Items[Combobox1.ItemIndex]); dt := StrToDate('01.01.' + ComboBox3.Items[Combobox3.ItemIndex]) //edYear.Text) + (iWeek1 -1 + StrToInt(ComboBox2.Items[Combobox2.ItemIndex])) * 7; iWeek2 := WeekOfTheYear(dt); iMon2 := MonthOfTheYear(dt); iYear2 := YearOf(dt); if iWeek2 < iWeek1 then if iMon2 = 12 then Inc(iYear2); Label6.Caption := 'Datum = '+DateToStr(dt); Label7.Caption := 'Woche = '+IntToStr(iWeek2)+'/'+IntToStr(iYear2); end; |
AW: Kalenderwoche ermitteln
In der Hilfe habe ich folgendes gefunden
Delphi-Quellcode:
Wenn man die Aufrufvariante mit den zwei Parametern benutzt, dann bekommt man das hoffentlich richtige Jahr zur Woche.
Die Funktion gibt die Woche des Jahres zurück, das durch einen TDateTime-Wert repräsentiert wird.
Unit DateUtils Kategorie Datum/Zeit Delphi-Syntax: function WeekOfTheYear(const AValue: TDateTime): Word; overload; function WeekOfTheYear(const AValue: TDateTime; var AYear): Word; overload; Beschreibung Mit WeekOfTheYear können Sie die Woche des Jahres ermitteln, das durch den angegebenen TDateTime-Wert repräsentiert wird. WeekOfTheYear gibt einen Wert zwischen 1 und 53 zurück. AYear gibt das Jahr mit der angegebenen Woche zurück. Dieser Wert darf nicht mit dem Jahr in AValue identisch sein. Der Grund liegt darin, dass die erste Woche eines Jahres als erste Woche definiert ist, von der mindestens vier Tage in das betreffende Jahr fallen. Ist also der erste Kalendertag eines Jahres der Freitag, Samstag oder Sonntag, gibt WeekOfTheYear für die ersten drei oder zwei Tage oder für den ersten Tag des Kalenderjahres die Woche des vorhergehenden Jahres zurück. Entsprechendes gilt am Jahresende: Ist der letze Kalendertag eines Jahres ein Montag, Dienstag oder Mittwoch, gibt WeekOfTheYear für die letzten drei oder zwei Tage bzw. den letzten Tag des Kalenderjahres den Wert 1 (erste Woche des nächsten Kalenderjahres) zurück. Hinweis: WeekOfTheYear verwendet die Wochendefinition des ISO-Standards 8601. Demzufolge beginnt eine Woche am Montag und endet mit dem Sonntag. Hinweis: WeekOfTheYear gibt den gleichen Wert wie die Funktion WeekOf zurück. Zum 31.12.2003 wird als Woche/Jahr => 01/2004 geliefert. Das JAHR der WOCHE und des konkreten Tages stimmen beim Jahreswechsel nicht zwingend überein.
Delphi-Quellcode:
Var
wo,jw : Word; :::: wo := WeekOfTheYear(pdDate, jw); |
AW: Kalenderwoche ermitteln
Hallo,
wenn man kein DateUtils hat und so und so auf "Handarbeit" steht, macht es folgender Code richtig.
Delphi-Quellcode:
Bei Übergabe von Tag, Monat und Jahr an die Routine Kalenderwoche gibt's den richtigen Wert zurück.
function Schaltjahr(word_Jahr : Word) : Boolean;
Begin result := ( (word_Jahr mod 4 = 0) and not (word_Jahr mod 100 = 0) ) or (word_Jahr mod 400 = 0); end; function Wochentag_(t, m : Byte; j : Word) : Byte; const c1 : ARRAY[1..12] OF Byte = (0,3,3,6,1,4,6,2,5,0,3,5); c2 : ARRAY[0..3] OF Byte = (6,4,2,0); var a,w, j1, j2 : Byte; begin j1 := j div 100; j2 := j mod 100; a:= (t MOD 7) + (c1[m]) + (j2 MOD 7) + ((j2 DIV 4) MOD 7) + (c2[(j1 MOD 4)]); IF Schaltjahr(j) THEN Dec(a); w := a MOD 7; Wochentag_ := w; end; function Kalendertag(tag, monat : byte; jahr : word) : Word; const TageProMonat : ARRAY[1..11] OF Byte =(31,28,31,30,31,30,31,31,30,31,30); var counter : Byte; GesamtTage : Word; begin GesamtTage:=0; FOR counter := 1 TO (monat-1) DO GesamtTage := GesamtTage + TageProMonat[counter]; GesamtTage := GesamtTage + tag; IF Schaltjahr(jahr) AND (monat > 2) THEN Inc(GesamtTage); Kalendertag := GesamtTage; end; function Kalenderwoche(Tag, Monat: Byte; Jahr : Word) : Byte; var Kalendertage, Vorjahr : Word; Woche, Primus : Byte; const Korrektur : ARRAY[0..6,1..2] OF ShortInt = ((-6,0),(0,1),(-1,1),(-2,1),(-3,1),(-4,0),(-5,0)); begin kalendertage:=kalendertag(tag,monat,jahr); Vorjahr := Jahr - 1; Primus:=Wochentag_(1,1,Jahr); Woche:=Trunc((Kalendertage - 1 - Korrektur[Primus,1]) / 7) + Korrektur[Primus,2]; IF (Woche = 53) THEN BEGIN IF (Primus = 4) OR (Wochentag_(31,12, Jahr) = 4) THEN Woche := 53 ELSE Woche := 1; END; IF (Woche=0) THEN BEGIN IF ((Wochentag_(31,12, Vorjahr) = 4) OR (Wochentag_(1,1, Vorjahr) = 4)) THEN Woche := 53 ELSE Woche := 52; END; Kalenderwoche:=Woche; end; Diese Berechnung habe ich seit Jahren im Gebrauch und sie funktioniert tadellos. Beste Grüße Mathematiker |
AW: Kalenderwoche ermitteln
Ich habe mal (vor 20 Jahren oder so: Grauenvolle Nomenklatur) diesen Code produziert. Bisher hat sich auch noch niemand beschwert, und etwas einfacher und verständlicher als der Code vom Mathematiker ist er auch. Vielleicht stimmt die Berechnugn für das Jahr 6592 nicht, aber mir ist das wurscht.
Delphi-Quellcode:
Function CsGetWeek(_Date: TDateTime): Word;
// Zunächst wird die KW des 1.1 des Jahres ermittelt. // Sind in der ersten KW des Jahres mehr als vier Tage, // dann ist dies die KW 1, sonst die KW '0' bzw. // die KW des 31.12. des vorherigen Jahres. Var MondayOfKW1, FirstOfJanuary: TDateTime; Dow, KW, y, m, d: Word; Begin DecodeDate(_Date, y, m, d); FirstOfJanuary := EncodeDate(Y, 1, 1); Dow := SysUtils.DayOfWeek(FirstOfJanuary); If Dow <= 5 Then MondayOfKW1 := FirstOfJanuary - Dow + 1 Else MondayOfKW1 := FirstOfJanuary + 8 - Dow; KW := Trunc(_Date - MondayOfKW1) Div 7 + 1; If KW < 1 Then KW := CsGetWeek(EncodeDate(Y - 1, 12, 31)) Else If KW = 53 Then If SysUtils.DayOfWeek(EncodeDate(Y + 1, 1, 1)) <= 4 Then KW := 1; Result := KW; End; |
AW: Kalenderwoche ermitteln
Im nächsten Forum gebe ich mir auch einen Frauennamen, damit sich an trivialen Fragen die Herren die Zähne ausbeissen.
Sherlock |
AW: Kalenderwoche ermitteln
Die Kalenderwoche zu einem Datum zu ermitteln war nicht die ursprüngliche Aufgabe, sondern zu Woche/Jahr eine Anzahl Wochen zu addieren, um wieder Woche/Jahr zu erhalten. Dabei können die Anzahl Wochen auch mehrere Jahre (mit und ohne Schaltjahre) sein, z.B. um S21 oder BER fertigzustellen.
|
AW: Kalenderwoche ermitteln
Hallo,
ich weiß nicht, ob es in Delphi 2009 DateUtils schon gab. Damit gibt es jedenfalls mehrere Möglichkeiten, wie die gestellt Aufgabe gelöst werden kann. Hier ein Beispiel (ed.. sind TEdit und lbl.. TLabel):
Delphi-Quellcode:
Und wenn jemand möglichst wenig Zeilen haben will, dann kann man das Ganze auch so schreiben, dass man(n/frau) beim Lesen denken muss:
uses ..., DateUtils;
procedure TForm1.Button1Click(Sender: TObject); var dtJahr, dtWoche, dtDifferenz: Word; dt: TDateTime; begin dt := EncodeDateWeek(StrToInt(edJahr.Text), StrToInt(edWoche.Text)); dt := IncWeek(dt, StrToInt(edDifferenz.Text)); DecodeDateWeek(dt, dtJahr, dtWoche, dtDifferenz); lblJahr.Caption := IntToStr(dtJahr); lblWoche.Caption := IntToStr(dtWoche); end;
Delphi-Quellcode:
uses ..., DateUtils;
procedure TForm1.Button1Click(Sender: TObject); var dtJahr, dtWoche, dtDifferenz: Word; dt: TDateTime; begin DecodeDateWeek(IncWeek(EncodeDateWeek(StrToInt(edJahr.Text), StrToInt(edWoche.Text)), StrToInt(edDifferenz.Text)), dtJahr, dtWoche, dtDifferenz); lblJahr.Caption := IntToStr(dtJahr); lblWoche.Caption := IntToStr(dtWoche); end; |
AW: Kalenderwoche ermitteln
Das klappt auch bei meinem Delphi 7 wunderbar, man kann sogar eine negative Anzahl Wochen eingeben, um im Kalender rückwärts zu rechen.
|
Alle Zeitangaben in WEZ +1. Es ist jetzt 19:45 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