Tips (1541)

Tip Bewertung (6):

{
  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;