DBR Delphi-Ecke

// Es kann ein bestimmter Tag vor oder nach einem gegebenen Datum ermittelt
// werden (Im 1. Beispiel wird das Datum des letzten Sonntags vor dem
// 9. August 2002 ermittelt, im 2. Beispiel der nächstfolgende Donnerstag).
// Dazu benötigt man die entsprechende Zahl für den gesuchten Wochentag
// (1 = Sonntag .. 7 = Samstag).

// Getestet mit D4 unter WinME

function TagVorNachDatum(tag: integer; datum: TDate; davor: boolean): TDate; 
var i: integer; 
  function rechnen: integer; 
  begin 
    if davor then result := -7 * ord(i <= tag) else 
      result := 7 * ord(i >= tag); 
  end; 
begin 
  i := dayofweek(datum); result := datum + tag + rechnen - i; 
end; 
 
// Beispiele 
 
procedure TFormx.Button4Click(Sender: TObject); 
var s: string; 
begin 
  s := DatetoStr(TagVorNachDatum(1, strtodate('9.8.2002'), true)); 
  showmessage(s); 
end; 
 
procedure TFormx.Button4Click(Sender: TObject); 
var s: string; 
begin 
  s := DatetoStr(TagVorNachDatum(5, strtodate('9.8.2002'), false)); 
  showmessage(s); 
end;

// Auf Grundlage der obigen Funktion kann man auch die Anzahl eines bestimmten
// Wochentages innerhalb einer gewissen Zeitspanne berechnen. Wobei wieder
// (entsprechend von DayOfWeek) 1 = Sonntag, 2 = Montag ... 7 = Samstag ist.

function wievielmal(von, bis: TDate; tg: integer): integer; 
var v, b: TDate; 
begin 
  if von > bis then result := -1 else begin 
    if dayofweek(von) = tg then v := von else 
      v := TagVorNachDatum(tg, von, false); 
    if dayofweek(bis) = tg then b := bis else 
      b := TagVorNachDatum(tg, bis, true); 
    if v > b then result := 0 else 
      result := 1 + trunc(b - v) div 7; 
  end; 
end; 
 
// Beispielaufruf: 
// Wieviel Samstage liegen zwischen dem 1. Januar und einschl. dem 24. Februar 2008 
 
procedure TForm1.Button2Click(Sender: TObject); 
var i: integer; 
begin 
  i := wievielmal(strtodate('1.1.2008'), strtodate('24.2.2008'), 7); 
  if i < 0 then showmessage('Fehler') else 
    showmessage(inttostr(i)); 
end;