Mega Code Archive
Get the dates for monday - friday of the current week
<![CDATA[
{
Data sometimes have to be filtered regarding to working days (Mo.-Fri.) of the
current Week. Following procs set your TDateTimePicker automatically.
Zur Filterung von Daten müssen oft Datumsgrenze ermittelt bzw. gesetzt werden.
Hier geht's um Werkstage (Mo.-Fr.), z.B. zur Vorbelegung von TDateTimePicker.
}
function GetMonday(RefDay: TDate): TDate;
var
DoW: Integer;
DateOffset: Integer;
begin
DoW := DayOfWeek(RefDay);
// Montag der Woche
if DoW = 1 then DateOffset := -6
else
DateOffset := Dow - 2;
Result := RefDay - DateOffset;
end;
function GetFriday(RefDay: TDate): TDate;
var
DoW: Integer;
DateOffset: Integer;
begin
DoW := DayOfWeek(RefDay);
{
Friday of current week
Freitag der Woche
}
if DoW = 1 then DateOffset := -2
else
DateOffset := Dow - 6;
Result := RefDay - DateOffset;
end;
procedure SetWorkingDaysFilter(S, E: TDateTimePicker);
var
N: TDate;
begin
N := Now;
S.Date := GetMonday(N);
E.Date := GetFriday(N);
end;
{Just as short as simple}
{Einfach und kurz}
type
TForm1 = class(TForm)
DStart: TDateTimePicker;
DEnd: TDateTimePicker;
btSetFilter: TButton;
procedure btSetFilterClick(Sender: TObject);
end;
procedure TForm1.btSetFilterClick(Sender: TObject);
begin
SetWorkingDaysFilter(DStart, DEnd);
end;
]]>