Entwickler-Ecke

Open Source Projekte - Komponente zur Feiertagsberechnung


Burgpflanze - Fr 01.11.02 13:14
Titel: Komponente zur Feiertagsberechnung
Um es kurz zu machen - siehe Kommentar im Code :wink:


Delphi-Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
 
unit Holidays;

{
  Komponente zur Bestimmung von Feier- und Sondertagen

  Handhabung: - Komponente auf ein Formular ziehen
              - In 'Region' das Bundesland einstellen
              - 'Date' zur Laufzeit setzen (geht auch zur Entwurfszeit, aber wozu ;-))
              - Wenn 'Date' ein Feiertag ist, wird das Ereignis 'OnHoliday' ausgelöst,
                wenn ein Sondertag, dann das Ereignis 'OnSpecialday'
              - Man kann auf die Ereignisse verzichten und benutzt stattdessen die
                Funktionen 'IsHoliday' und 'IsSpecialday', natürlich erst, nachdem 'Date'
                entsprechend gesetzt wurde

                Rückgabewert bei beiden Funktionen ist vom Typ Boolean

  Coopright : - die Funktionen zur Berechnung hab ich irgendwann mal im Internet gefunden,
                leider ist mir der Verfasser nicht bekannt
                (Fehler bei Berechnung von 'Allerheiligen' gefixt)
              - Ich hab dies dann nur in eine Komponente verpackt

  Co-Author : Peter Gaede (das bin ich ;-))
              mail: peter-gaede@t-online.de
}

interface

uses
  Classes, Controls, SysUtils;

type
  TRegion = (rBadenWuertenberg, rBayern, rBerlin, rBrandenburg, rBremen,
    rHamburg, rHessen, rMecklenburgVorpommern, rNiedersachsen, rNordrheinWestfalen,
    rRheinlandPfalz, rSaarland, rSachsen, rSachsenAnhalt, rSchleswigHolstein,
    rThueringen);

  THolidayEvent = procedure(Sender: TObject; AHolidayName: String) of Object;
  TSpecialDayEvent = procedure(Sender: TObject; ASpecialdayName: String) of Object;

  THolidays = class(TComponent)
  private
    FDate: TDate;
    FHoliday: array[1..365] of Integer;
    FHolidayName: String;
    FSpecialdayName: String;
    FRegion: TRegion;
    FOnHoliday: THolidayEvent;
    FOnSpecialday: TSpecialdayEvent;
    FOnInvalidDate: TNotifyEvent;
    procedure CalcHolidays;
    procedure SetDate(const Value: TDate);
    procedure SetRegion(const Value: TRegion);
  public
    constructor Create(AOwner: TComponent); override;
    function IsHoliday: Boolean;
    function IsSpecialday: Boolean;
  published
    property Date: TDate read FDate write SetDate;
    property HolidayName: String read FHolidayName;
    property SpecialdayName: String read FSpecialdayName;
    property Region: TRegion read FRegion write SetRegion;
    property OnHoliday: THolidayEvent read FOnHoliday write FOnHoliday;
    property OnSpecialday: TSpecialdayEvent read FOnSpecialday write FOnSpecialday;
    property OnInvalidDate: TNotifyEvent read FOnInvalidDate write FOnInvalidDate;
  end;

procedure Register;

implementation

uses
  DateUtils, Dialogs;

const
  HOLIDAY_NAME : array [1..19] of string[25] =
   ('Neujahr','Maifeiertag','Tag der deutschen Einheit','Allerheiligen',
    'Totensonntag','Volkstrauertag','1. Weihnachtstag','2. Weihnachtstag',
    'Karfreitag','Ostersonntag','Ostermontag','Christi Himmelfahrt',
    'Pfingstsonntag','Pfingstmontag','Fronleichnam','Heilige 3 Könige',
    'Mariä Himmelfahrt','Reformationstag','Buß- und Bettag');
  SPECIALDAY_NAME : array [1..24] of string[25] =
   ('Mariä Lichtmeß','Valentinstag','Weiberfastnacht','Rosenmontag','Fastnacht',
    'Aschermittwoch','Mariä Verkündigung','Palmsonntag','Gründonnerstag','Muttertag',
    'Peter und Paul','Mariä Geburt','Erntedankfest','Mariä Empfängnis','Silvester',
    '1. Advent','2. Advent','3. Advent','4. Advent','Heiligabend','Frühlingsanfang',
    'Sommmeranfang','Herbstanfang','Winteranfang');

procedure Register;
begin
  RegisterComponents('Samples', [THolidays]);
end;

{ THolidays }

procedure THolidays.CalcHolidays;
var
  d,  dw, om, aw, year: Word;
  dat: TDate;
  Eastern: TDate;
  Christmas: TDate;

  function GetEasternSunday: TDate;
  var
    a, b, c, d, e, tag, monat: Integer;
  begin
    a := year mod 19;
    b := year mod 4;
    c := year mod 7;
    d := (19 * a + 24) mod 30;
    e := (2 * b + 4 * c + 6 * d + 5) mod 7;
    tag := 22 + d + e;
    monat := 3;
    if Tag > 31 then
    begin
      tag := d + e - 9;
      monat := 4;
    end;
    if (tag = 26) and (monat = 4) then tag := 19;
    if (tag = 25) and (monat = 4) and (d = 28) and (e = 6) and (a > 10) then tag := 18;
    try
     Result := EncodeDate(year, monat, tag);
    except
      Result := 0;
    end;
  end;

begin
  for d := 1 to 365 do FHoliday[d] := 0;

  year := YearOf(FDate);

  Eastern := GetEasternSunday;
  try
    DecodeDate(Eastern, year, om, d);
  except
    om := 4;
  end;

  try
    Christmas := EncodeDate(year , 12, 25);
    if (DayOfWeek(Christmas) - 1) = 0 then dw := 7
    else dw := DayOfWeek(Christmas) - 1;
  except
    Christmas := -1;
    dw := 0;
  end;

  {Mariä Lichtmeß}                     {Sondertage}
  dat := EncodeDate(year, 2, 2);
  FHoliday[DayOfTheYear(dat)] := -1;

  {Valentinstag}
  dat := Encodedate(year, 2, 14);
  FHoliday[DayOfTheYear(dat)] := -2;

  {Weiberfastnacht}
  dat := Eastern - 45;
  while DayOfWeek(dat) <> 2 do dat := dat -1;
  FHoliday[DayOfTheYear(dat) - 4] := -3;

  {Rosenmontag}
  FHoliday[DayOfTheYear(dat)] := -4;

  {Fastnacht}
  FHoliday[DayOfTheYear(dat) + 1] := -5;

  {Aschermittwoch}
  FHoliday[DayOfTheYear(dat) + 2] := -6;

  {Mariä Verkündigung}
  dat := Encodedate(year, 3, 25);
  FHoliday[DayOfTheYear(dat)] := -7;

  {Palmsonntag}
  FHoliday[DayOfTheYear(Eastern) - 7] := -8;

  {Gründonnerstag}
  FHoliday[DayOfTheYear(Eastern) - 3] := -9;

  {Muttertag}
  dat := EncodeDate(year, 4, 30);
  aw := DayOfWeek(dat) - 1;
  dat := dat - aw + 14;
  if dat = Eastern + 49 then dat := dat - 7;
  FHoliday[DayOfTheYear(dat)] := -10;

  {Peter und Paul}
  dat := EncodeDate(year, 6, 29);
  FHoliday[DayOfTheYear(dat)] := -11;

  {Mariä Geburt}
  dat := EncodeDate(year, 9, 8);
  FHoliday[DayOfTheYear(dat)] := -12;

  {Erntedankfest}
  dat := EncodeDate(year, 10, 1);
  while DayOfWeek(dat) <> 1 do dat := dat + 1;;
  FHoliday[DayOfTheYear(dat)] := -13;

  {Mariä Empfängnis}
  dat := EncodeDate(year, 12, 8);
  FHoliday[DayOfTheYear(dat)] := -14;

  {Silvester}
  dat := EncodeDate(year, 12, 31);
  FHoliday[DayOfTheYear(dat)] := -15;

  {1. Advent}
  dat := Christmas;
  while DayOfWeek(dat) <> 1 do dat := dat - 1;
  FHoliday[DayOfTheYear(dat)-21] := -16;

  {2. Advent}
  FHoliday[DayOfTheYear(dat) - 14] := -17;

  {3. Advent}
  FHoliday[DayOfTheYear(dat) - 7] := -18;

  {4. Advent}
  FHoliday[DayOfTheYear(dat)] := -19;

  {Heiligabend}
  FHoliday[DayOfTheYear(Christmas) - 1] := -20;

  {Frühlingsanfang}
  dat := EncodeDate(year, 3, 21);
  FHoliday[DayOfTheYear(dat)] := -21;

  {Sommmeranfang}
  dat := EncodeDate(year, 6, 21);
  FHoliday[DayOfTheYear(dat)] := -22;

  {Herbstanfang}
  dat:=EncodeDate(year, 9, 23);
  FHoliday[DayOfTheYear(dat)] := -23;

  {Winteranfang}
  dat := EncodeDate(year, 12, 22);
  FHoliday[DayOfTheYear(dat)] := -24;

  {Neujahr}                         {Feiertage}
  FHoliday[1] := 1;

  {Maifeiertag}
  dat := EncodeDate(year, 5, 1);
  FHoliday[DayOfTheYear(dat)] := 2;

  {Tag der deutschen Einheit}
  dat := EncodeDate(year, 10, 3);
  FHoliday[DayOfTheYear(dat)] := 3;

  {Allerheiligen}                     // ConfigLand anpassen: Bayern, BaWü, NRW, RP, Saarland
  if (FRegion = rBayern) or (FRegion = rBadenWuertenberg) or
    (FRegion = rNordrheinWestfalen) or (FRegion = rRheinlandPfalz) or
    (FRegion = rSaarland) then
  begin
    dat := EncodeDate(year, 11, 1);
    FHoliday[DayOfTheYear(dat)] := 4;
  end;

  {Totensonntag}
  if Christmas >= 0 then FHoliday[DayOfTheYear(Christmas - dw - 28)] := 5;

  {Buß- und Bettag}
  if FRegion = rSachsen then FHoliday[DayOfTheYear(Christmas - dw - 32)] := 19;

  {Volkstrauertag}
  if Christmas >= 0 then FHoliday[DayOfTheYear(Christmas - dw - 35)] := 6;

  {1. Weihnachtstag}
  if Christmas >= 0 then FHoliday[DayOfTheYear(Christmas)] := 7;

  {2. Weihnachtstag}
  if Christmas >= 0 then FHoliday[DayOfTheYear(Christmas) + 1] := 8;

  {Karfreitag}
  FHoliday[DayOfTheYear(Eastern) - 2] := 9;

  {Ostersonntag}
  FHoliday[DayOfTheYear(Eastern)] := 10;

  {Ostermontag}
  FHoliday[DayOfTheYear(Eastern) + 1] := 11;

  {Christi Himmelfahrt}
  FHoliday[DayOfTheYear(Eastern) + 39] := 12;

  {Pfingstsonntag}
  FHoliday[DayOfTheYear(Eastern) + 49] := 13;

  {Pfingstmontag}
  FHoliday[DayOfTheYear(Eastern) + 50] := 14;

  {Fronleichnam}
  if (FRegion = rBerlin) or ((FRegion = rNordrheinWestfalen) and (FRegion <= rSachsen)) or
    (FRegion = rThueringen) then FHoliday[DayOfTheYear(Eastern) + 60] := 15;

  {Heilige 3 Könige}
  if (FRegion = rBadenWuertenberg) or (FRegion = rBayern) or (FRegion = rSachsenAnhalt) then
    FHoliday[6] := 16;

  {Mariä Himmelfahrt}
  if (FRegion = rBayern) or (FRegion = rSaarland) then
  begin
    dat := EncodeDate(year, 8, 15);
    FHoliday[DayOfTheYear(dat)] := 17;
  end;

  {Reformationstag}
  if (FRegion = rBrandenburg) or (FRegion = rMecklenburgVorpommern) or
    (FRegion = rSachsen) or (FRegion = rSachsenAnhalt) or (FRegion = rThueringen) then
  begin
    dat := EncodeDate(year, 10, 31);
    FHoliday[DayOfTheYear(dat)] := 18;
  end;
end;

constructor THolidays.Create(AOwner: TComponent);
begin
  inherited;
  FRegion := rSachsenAnhalt;
  SetDate(Now);
end;

function THolidays.IsHoliday: Boolean;
begin
  Result := (FHolidayName <> '');
end;

function THolidays.IsSpecialday: Boolean;
begin
  Result := (FSpecialdayName <> '');
end;

procedure THolidays.SetDate(const Value: TDate);
var
  h, y1, y2: Integer;
begin
  y1 := YearOf(FDate);
  y2 := YearOf(Value);

  if not IsValidDate(y2, MonthOf(Value), DayOf(Value)) or (Value <= 0) then
  begin
    if Assigned(FOnInvalidDate) then FOnInvalidDate(Self);
    Exit;
  end;

  FDate := Value;
  if y1 <> y2 then CalcHolidays;

  FHolidayName := '';
  FSpecialDayName := '';
  h := FHoliday[DayOfTheYear(FDate)];
  if h > 0 then
  begin
    FHolidayName := HOLIDAY_NAME[h];
    if Assigned(FOnHoliday) then FOnHoliday(Self, FHolidayName);

  end
  else if h < 0 then
  begin
    FSpecialDayName := SPECIALDAY_NAME[-h];
    if Assigned(FOnSpecialDay) then FOnSpecialDay(Self, FSpecialDayName);
  end;
end;

procedure THolidays.SetRegion(const Value: TRegion);
begin
  FRegion := Value;
  CalcHolidays;
  SetDate(FDate);
end;

end.




Gruss, Burgpflanze

Moderiert von user profile iconNarses: Code- durch Delphi-Tags ersetzt


jensenwb - Mo 25.11.02 14:58
Beim Installieren deine Kompo mault er rum das ihn die datei DATEUTILS.DCU fehlt.

Ich benutze Delphi3 Professionel.

Kannst du mir die Datei mal per Mail schicken
jens.neubieser@web.de


Burgpflanze - Mo 25.11.02 15:06
Die Unit "DateUtils" gibt es leider erst ab Delphi6 :X

Gruss, Burgpflanze


Anonymous - Mi 01.01.03 14:25
@Burgpflanze

Deine Komponente ist nicht zu gebrauchen, da sie einige wichtige Feiertage nicht beachtet, z.B. 11.11 (Karnevasanfang), Weiberfastnacht, Rosenmontag usw. Als Kölner kann ich also nur bedingt deine Kompo nutzten ;)


Brueggendiek - Mi 01.01.03 19:55
@Popov:

Die Komponente ist doch Open Source, also bau Dir Deine speziellen Feiertage doch bitteschön selber ein ! :mrgreen:

Gruß

Dietmar Brüggendiek


Delete - Mi 01.01.03 21:08
Brueggendiek hat folgendes geschrieben:
@Popov:
Die Komponente ist doch Open Source, also bau Dir Deine speziellen Feiertage doch bitteschön selber ein ! :mrgreen:


Geil, die Antwort. So eine möchte ich auch mal von Microsoft bekommen, wenn sie auf einen Bug hingewiesen worden sind.


Brueggendiek - Do 02.01.03 00:15
Hallo!

Luckie hat folgendes geschrieben:
Geil, die Antwort. So eine möchte ich auch mal von Microsoft bekommen, wenn sie auf einen Bug hingewiesen worden sind.


Das Kompliment gebe ich hiermit zurück! Was wäre das schön, wenn MS Open Source hätte, dann könnte ich die Bugs selber rausziehen - und brauchte nicht auf den Bugfix zu warten, der dann 2 weitere Bugs reinbringt!


Im Übrigen ist das Fehlen nur regional (oder persönlich) vorhandener Feiertage (was ist mit meinem Geburtstag :?: ) kein Bug :!:

Nebenbei: Über eine Art Terminkalender hatte ich auch schon mal nachgedacht. Da gab es für mich ein Problem, daß ein Ereignis regelmäßig am "Samstag vor dem 3. Sonntag im Juni" stattfindet. Vorsicht Falle: Das ist nicht immer der 3. Samstag!!! Beginnt ein Monat am Sonntag, ist der 1. Samstag der 6., der Samstag vor dem 1. Sonntag aber der letzte Tag des Vormonats :!:
Eine Eintragsmöglichkeit für vom Programmierer nicht vorgesehener Feiertage wäre auch nicht schlecht. Beim Karneval z.B. ist es aber so, daß der 11.11. datumsmäßig festliegt und Weiberfastnacht, Rosenmontag etc. von Ostern abhängig sind. Wird schwer zu realisieren sein (wie sagt der Benutzer es meinem Programm?)!

Gruß

Dietmar Brüggendiek


Delete - Do 02.01.03 09:37
Brueggendiek hat folgendes geschrieben:
Das Kompliment gebe ich hiermit zurück! Was wäre das schön, wenn MS Open Source hätte, dann könnte ich die Bugs selber rausziehen ...

Bei allem Respekt vor deinen sicher vorhandenen Fähigkeiten, aber das glaube ich nicht! Auch wenn über Windows, Office, usw. geschimpft wird, es ist trotzdem keine Software, aus der ein Einzelner "mal eben" ein paar Bugs entfernen kann.


Ich persönlich halte es mit der Software hier in dieser Sparte so, dass ich mir den Quellcode nur angucke, wenn ich glaube, dass man etwas ändern müsste. Und sofern es geht, führe ich die Änderung auch selbst aus. Wie etwa bei Luckies "ShowErrorMsg", das zwar 2 Zeilen aber bei mir nicht 3 Zeilen Fehlertexte anzeigen kann.
Nur - was nutzt es, wenn ich für mich diese Änderung ausführe? Davon haben die anderen, die sich ebenfalls für die Software/Komponente/... interessieren ja nichts. Und es ist nicht meine Aufgabe, korrigierte Versionen anderer Programme zu veröffentlichen. Es sei denn, es ist ein Gemeinschaftsprojekt wie der Portscanner.

Und wenn ich z.B. in einer Software nichts ändern und kompilieren kann (weil mir zum Kompilieren eine Bibliothek fehlt, die ich nicht nutze - etwa RXLib bei der "UPXShell" von Hinterwäldler), dann schaue ich mir nur den ausführbaren Code an, weise auf Fehler hin, lösche den Quellcode und hoffe, dass der Entwickler/Programmierer/Bastler des Programms die von mir genannten Probleme nicht als "Meckern" auffasst und sie beseitigt!


HeikoAdams - Mi 25.06.08 10:07
Die Komponente funktionierte leider nicht, wenn das aktuelle Jahr ein Schaltjahr ist, da Schaltjahre 366 Tage haben.
Hier mein gefixter Code.

Delphi-Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
 
unit Holidays;

{
  Komponente zur Bestimmung von Feier- und Sondertagen

  Handhabung: - Komponente auf ein Formular ziehen
              - In 'Region' das Bundesland einstellen
              - 'Date' zur Laufzeit setzen (geht auch zur Entwurfszeit, aber wozu ;-))
              - Wenn 'Date' ein Feiertag ist, wird das Ereignis 'OnHoliday' ausgelöst,
                wenn ein Sondertag, dann das Ereignis 'OnSpecialday'
              - Man kann auf die Ereignisse verzichten und benutzt stattdessen die
                Funktionen 'IsHoliday' und 'IsSpecialday', natürlich erst, nachdem 'Date'
                entsprechend gesetzt wurde

                Rückgabewert bei beiden Funktionen ist vom Typ Boolean

  Coopright : - die Funktionen zur Berechnung hab ich irgendwann mal im Internet gefunden,
                leider ist mir der Verfasser nicht bekannt
                (Fehler bei Berechnung von 'Allerheiligen' gefixt)
              - Ich hab dies dann nur in eine Komponente verpackt

  Co-Author : Peter Gaede (das bin ich ;-))
              mail: peter-gaede@t-online.de

  Historie  :
            1.1 (25.06.2008):
            - Problem mit Schaltjahren gefixt (Heiko Adams)
}

interface

uses
  Classes, Controls, SysUtils;

type
  TRegion = (rBadenWuertenberg, rBayern, rBerlin, rBrandenburg, rBremen,
    rHamburg, rHessen, rMecklenburgVorpommern, rNiedersachsen,
      rNordrheinWestfalen,
    rRheinlandPfalz, rSaarland, rSachsen, rSachsenAnhalt, rSchleswigHolstein,
    rThueringen);

  THolidayEvent = procedure(Sender: TObject; AHolidayName: string) of object;
  TSpecialDayEvent = procedure(Sender: TObject; ASpecialdayName: string) of
    object;

  THolidays = class(TComponent)
  private
    FDate: TDate;
    FHoliday: array of Integer;
    FHolidayName: string;
    FSpecialdayName: string;
    FRegion: TRegion;
    FOnHoliday: THolidayEvent;
    FOnSpecialday: TSpecialdayEvent;
    FOnInvalidDate: TNotifyEvent;
    procedure CalcHolidays;
    procedure SetDate(const Value: TDate);
    procedure SetRegion(const Value: TRegion);
  public
    constructor Create(AOwner: TComponent); override;
    function IsHoliday: Boolean;
    function IsSpecialday: Boolean;
  published
    property Date: TDate read FDate write SetDate;
    property HolidayName: string read FHolidayName;
    property SpecialdayName: string read FSpecialdayName;
    property Region: TRegion read FRegion write SetRegion;
    property OnHoliday: THolidayEvent read FOnHoliday write FOnHoliday;
    property OnSpecialday: TSpecialdayEvent read FOnSpecialday write
      FOnSpecialday;
    property OnInvalidDate: TNotifyEvent read FOnInvalidDate write
      FOnInvalidDate;
  end;

procedure Register;

implementation

uses
  DateUtils, Dialogs;

const
  HOLIDAY_NAME: array[1..19] of string[25] =
    ('Neujahr', 'Maifeiertag', 'Tag der deutschen Einheit', 'Allerheiligen',
    'Totensonntag', 'Volkstrauertag', '1. Weihnachtstag', '2. Weihnachtstag',
    'Karfreitag', 'Ostersonntag', 'Ostermontag', 'Christi Himmelfahrt',
    'Pfingstsonntag', 'Pfingstmontag', 'Fronleichnam', 'Heilige 3 Könige',
    'Mariä Himmelfahrt', 'Reformationstag', 'Buß- und Bettag');
  SPECIALDAY_NAME: array[1..24] of string[25] =
    ('Mariä Lichtmeß', 'Valentinstag', 'Weiberfastnacht', 'Rosenmontag',
      'Fastnacht',
    'Aschermittwoch', 'Mariä Verkündigung', 'Palmsonntag', 'Gründonnerstag',
      'Muttertag',
    'Peter und Paul', 'Mariä Geburt', 'Erntedankfest', 'Mariä Empfängnis',
      'Silvester',
    '1. Advent', '2. Advent', '3. Advent', '4. Advent', 'Heiligabend',
      'Frühlingsanfang',
    'Sommmeranfang', 'Herbstanfang', 'Winteranfang');

procedure Register;
begin
  RegisterComponents('Samples', [THolidays]);
end;

{ THolidays }

procedure THolidays.CalcHolidays;
var
  d, dw, om, aw, year: Word;
  dat: TDate;
  Eastern: TDate;
  Christmas: TDate;

  function GetEasternSunday: TDate;
  var
    a, b, c, d, e, tag, monat: Integer;
  begin
    a := year mod 19;
    b := year mod 4;
    c := year mod 7;
    d := (19 * a + 24) mod 30;
    e := (2 * b + 4 * c + 6 * d + 5) mod 7;
    tag := 22 + d + e;
    monat := 3;
    if Tag > 31 then
    begin
      tag := d + e - 9;
      monat := 4;
    end;
    if (tag = 26) and (monat = 4) then
      tag := 19;
    if (tag = 25) and (monat = 4) and (d = 28) and (e = 6) and (a > 10) then
      tag := 18;
    try
      Result := EncodeDate(year, monat, tag);
    except
      Result := 0;
    end;
  end;

begin
  //for d := 1 to 365 do
  for d := 1 to High(FHoliday) do
    FHoliday[d] := 0;

  year := YearOf(FDate);

  Eastern := GetEasternSunday;
  try
    DecodeDate(Eastern, year, om, d);
  except
    om := 4;
  end;

  try
    Christmas := EncodeDate(year, 12, 25);
    if (DayOfWeek(Christmas) - 1) = 0 then
      dw := 7
    else
      dw := DayOfWeek(Christmas) - 1;
  except
    Christmas := -1;
    dw := 0;
  end;

  {Mariä Lichtmeß}{Sondertage}
  dat := EncodeDate(year, 2, 2);
  FHoliday[DayOfTheYear(dat)] := -1;

  {Valentinstag}
  dat := Encodedate(year, 2, 14);
  FHoliday[DayOfTheYear(dat)] := -2;

  {Weiberfastnacht}
  dat := Eastern - 45;
  while DayOfWeek(dat) <> 2 do
    dat := dat - 1;
  FHoliday[DayOfTheYear(dat) - 4] := -3;

  {Rosenmontag}
  FHoliday[DayOfTheYear(dat)] := -4;

  {Fastnacht}
  FHoliday[DayOfTheYear(dat) + 1] := -5;

  {Aschermittwoch}
  FHoliday[DayOfTheYear(dat) + 2] := -6;

  {Mariä Verkündigung}
  dat := Encodedate(year, 3, 25);
  FHoliday[DayOfTheYear(dat)] := -7;

  {Palmsonntag}
  FHoliday[DayOfTheYear(Eastern) - 7] := -8;

  {Gründonnerstag}
  FHoliday[DayOfTheYear(Eastern) - 3] := -9;

  {Muttertag}
  dat := EncodeDate(year, 4, 30);
  aw := DayOfWeek(dat) - 1;
  dat := dat - aw + 14;
  if dat = Eastern + 49 then
    dat := dat - 7;
  FHoliday[DayOfTheYear(dat)] := -10;

  {Peter und Paul}
  dat := EncodeDate(year, 6, 29);
  FHoliday[DayOfTheYear(dat)] := -11;

  {Mariä Geburt}
  dat := EncodeDate(year, 9, 8);
  FHoliday[DayOfTheYear(dat)] := -12;

  {Erntedankfest}
  dat := EncodeDate(year, 10, 1);
  while DayOfWeek(dat) <> 1 do
    dat := dat + 1;

  FHoliday[DayOfTheYear(dat)] := -13;

  {Mariä Empfängnis}
  dat := EncodeDate(year, 12, 8);
  FHoliday[DayOfTheYear(dat)] := -14;

  {Silvester}
  dat := EncodeDate(year, 12, 31);
  FHoliday[DayOfTheYear(dat)] := -15;

  {1. Advent}
  dat := Christmas;
  while DayOfWeek(dat) <> 1 do
    dat := dat - 1;
  FHoliday[DayOfTheYear(dat) - 21] := -16;

  {2. Advent}
  FHoliday[DayOfTheYear(dat) - 14] := -17;

  {3. Advent}
  FHoliday[DayOfTheYear(dat) - 7] := -18;

  {4. Advent}
  FHoliday[DayOfTheYear(dat)] := -19;

  {Heiligabend}
  FHoliday[DayOfTheYear(Christmas) - 1] := -20;

  {Frühlingsanfang}
  dat := EncodeDate(year, 3, 21);
  FHoliday[DayOfTheYear(dat)] := -21;

  {Sommmeranfang}
  dat := EncodeDate(year, 6, 21);
  FHoliday[DayOfTheYear(dat)] := -22;

  {Herbstanfang}
  dat := EncodeDate(year, 9, 23);
  FHoliday[DayOfTheYear(dat)] := -23;

  {Winteranfang}
  dat := EncodeDate(year, 12, 22);
  FHoliday[DayOfTheYear(dat)] := -24;

  {Neujahr}{Feiertage}
  FHoliday[1] := 1;

  {Maifeiertag}
  dat := EncodeDate(year, 5, 1);
  FHoliday[DayOfTheYear(dat)] := 2;

  {Tag der deutschen Einheit}
  dat := EncodeDate(year, 10, 3);
  FHoliday[DayOfTheYear(dat)] := 3;

  {Allerheiligen}// ConfigLand anpassen: Bayern, BaWü, NRW, RP, Saarland
  if (FRegion = rBayern) or (FRegion = rBadenWuertenberg) or
    (FRegion = rNordrheinWestfalen) or (FRegion = rRheinlandPfalz) or
    (FRegion = rSaarland) then
  begin
    dat := EncodeDate(year, 11, 1);
    FHoliday[DayOfTheYear(dat)] := 4;
  end;

  {Totensonntag}
  if (Christmas >= 0) then
    FHoliday[DayOfTheYear(Christmas - dw - 28)] := 5;

  {Buß- und Bettag}
  if (FRegion = rSachsen) then
    FHoliday[DayOfTheYear(Christmas - dw - 32)] := 19;

  {Volkstrauertag}
  if (Christmas >= 0) then
    FHoliday[DayOfTheYear(Christmas - dw - 35)] := 6;

  {1. Weihnachtstag}
  if (Christmas >= 0) then
    FHoliday[DayOfTheYear(Christmas)] := 7;

  {2. Weihnachtstag}
  if (Christmas >= 0) then
    FHoliday[DayOfTheYear(Christmas) + 1] := 8;

  {Karfreitag}
  FHoliday[DayOfTheYear(Eastern) - 2] := 9;

  {Ostersonntag}
  FHoliday[DayOfTheYear(Eastern)] := 10;

  {Ostermontag}
  FHoliday[DayOfTheYear(Eastern) + 1] := 11;

  {Christi Himmelfahrt}
  FHoliday[DayOfTheYear(Eastern) + 39] := 12;

  {Pfingstsonntag}
  FHoliday[DayOfTheYear(Eastern) + 49] := 13;

  {Pfingstmontag}
  FHoliday[DayOfTheYear(Eastern) + 50] := 14;

  {Fronleichnam}
  if (FRegion = rBerlin) or ((FRegion = rNordrheinWestfalen) and (FRegion <=
    rSachsen)) or
    (FRegion = rThueringen) then
    FHoliday[DayOfTheYear(Eastern) + 60] := 15;

  {Heilige 3 Könige}
  if (FRegion = rBadenWuertenberg) or (FRegion = rBayern) or (FRegion =
    rSachsenAnhalt) then
    FHoliday[6] := 16;

  {Mariä Himmelfahrt}
  if (FRegion = rBayern) or (FRegion = rSaarland) then
  begin
    dat := EncodeDate(year, 8, 15);
    FHoliday[DayOfTheYear(dat)] := 17;
  end;

  {Reformationstag}
  if (FRegion = rBrandenburg) or (FRegion = rMecklenburgVorpommern) or
    (FRegion = rSachsen) or (FRegion = rSachsenAnhalt) or (FRegion = rThueringen)
      then
  begin
    dat := EncodeDate(year, 10, 31);
    FHoliday[DayOfTheYear(dat)] := 18;
  end;
end;

constructor THolidays.Create(AOwner: TComponent);
begin
  inherited;

  {Größe des Arrays anhand der Anzahl Tage im Jahr setzen}
  SetLength(FHoliday, DaysInYear(Now)+1);

  FRegion := rSachsenAnhalt;
  SetDate(Now);
end;

function THolidays.IsHoliday: Boolean;
begin
  Result := (FHolidayName <> '');
end;

function THolidays.IsSpecialday: Boolean;
begin
  Result := (FSpecialdayName <> '');
end;

procedure THolidays.SetDate(const Value: TDate);
var
  h, y1, y2: Integer;
begin
  y1 := YearOf(FDate);
  y2 := YearOf(Value);

  if not IsValidDate(y2, MonthOf(Value), DayOf(Value)) or (Value <= 0) then
  begin
    if Assigned(FOnInvalidDate) then
      FOnInvalidDate(Self);
    Exit;
  end;

  FDate := Value;
  if (y1 <> y2) then
    CalcHolidays;

  FHolidayName := '';
  FSpecialDayName := '';
  h := FHoliday[DayOfTheYear(FDate)];
  if (h > 0) then
  begin
    FHolidayName := HOLIDAY_NAME[h];
    if Assigned(FOnHoliday) then
      FOnHoliday(Self, FHolidayName);
  end
  else if (h < 0) then
  begin
    FSpecialDayName := SPECIALDAY_NAME[-h];
    if Assigned(FOnSpecialDay) then
      FOnSpecialDay(Self, FSpecialDayName);
  end;
end;

procedure THolidays.SetRegion(const Value: TRegion);
begin
  FRegion := Value;
  CalcHolidays;
  SetDate(FDate);
end;

end.


ssb-blume - Sa 08.11.08 12:38
Hallo,
Es gibt noch ein Problem:

z.B. 2008 ist der 1. Mai:

a) Maifeiertag
b) Christi Himmelfahrt
Was hat nun Vorrang?

Lösung:
die Feiertage nicht als Integer sondern Menge speichern!
Macht mal, ich habe keine Zeit.


JüTho - Sa 08.11.08 12:56
Hallo,

da das OpenSource-Unterforum zu Delphi und C-Sharp gehört, möchte ich auf diese Feiertagsberechnung mit C# [http://www.mycsharp.de/wbb2/thread.php?postid=256084#post256084] hinweisen.

Jürgen


ssb-blume - Do 13.11.08 14:24
Hallo,
ich hatte doch mal wieder Zeit. Und hier ist eine Komponente (in Delphi6.0) für
einen Kalender.
Obige Fehler beseitigt, vieles geändert. Schaut mal rein..

Neu: die Tage für Frühlingsanfang.. sind jetzt nach einem
Algorithmus berechnet!


Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!