Получить даты с понедельника по пятницу текущей недели |
Previous Top Next |
Code: |
{ 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;
|
©Drkb::00733
DelphiWorld 6.0