Получить даты с понедельника по пятницу текущей недели
{
Data sometimes have to be filtered regarding to working
days (Mo.-Fri.) of the current Week. Following procs set
your TDateTimePicker automatically.
}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;
Получить даты с понедельника по пятницу текущей недели с помощью функций GetMonday и GetFriday, а затем установить эти даты в поле ввода для начала и конца периода.
Комментарии и вопросы
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.