Mega Code Archive
How to get the dates for Monday C Friday of the current week
<![CDATA[
Title: How to get the dates for Monday C Friday of the current week
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;
]]>