Berechnungen mit Arbeitstagen

[himitsu]

Mit veränderbaren Tagen wird ein Schleifenloses rechnen aber immer schwerer

Delphi-Quellcode:

// 1=Monday ... 7=Sunday

Function IncDays(D: TDateTime; Days: Integer = 1;
  WorkingDays: TDayOfTheWeekSet = [1..5]): TDateTime;

Function IncDays(D: TDateTime; Days: Integer; WorkingDays: TDayOfTheWeekSet;
  Holidays: Array of TDateTime): TDateTime;

Function DecDays(D: TDateTime; Days: Integer = 1;
  WorkingDays: TDayOfTheWeekSet = [1..5]): TDateTime;

Function DecDays(D: TDateTime; Days: Integer; WorkingDays: TDayOfTheWeekSet;
  Holidays: Array of TDateTime): TDateTime;

Delphi-Quellcode:

Uses Math, DateUtils;

Type TDayOfTheWeekSet = Set of 1{Monday}..7{Sunday};

Function IncDays(D: TDateTime; Days: Integer = 1;
    WorkingDays: TDayOfTheWeekSet = [1..5]): TDateTime; Overload;

  Var i: Integer;

  Begin
    i := 0;
    While Days > 0 do Begin
      If DayOfTheWeek(D + i) in WorkingDays Then Dec(Days);
      Inc(i);
    End;
    While Days < 0 do Begin
      If DayOfTheWeek(D + i) in WorkingDays Then Inc(Days);
      Dec(i);
    End;
    Result := D + i;
  End;

Function IncDays(D: TDateTime; Days: Integer; WorkingDays: TDayOfTheWeekSet;
    Holidays: Array of TDateTime): TDateTime; Overload;

  Var i: Integer;

  Function isWorkingDays: Boolean;
    Var i2: Integer;
      D2: TDateTime;

    Begin
      Result := DayOfTheWeek(D + i) in WorkingDays;
      If not Result Then Exit;
      Result := False;
      D2 := Trunc(D + i);
      i2 := High(Holidays);
      While i2 >= Low(Holidays) do
        If SameValue(Trunc(Holidays[i2]), D2) Then Exit Else Dec(i2);
      Result := True;
    End;

  Begin
    i := 0;
    While Days > 0 do Begin
      If isWorkingDays Then Dec(Days);
      Inc(i);
    End;
    While Days < 0 do Begin
      If isWorkingDays Then Inc(Days);
      Dec(i);
    End;
    Result := D + i;
  End;

Function DecDays(D: TDateTime; Days: Integer = 1;
    WorkingDays: TDayOfTheWeekSet = [1..5]): TDateTime; Overload;
  Begin
    Result := IncDays(D, -Days, WorkingDays);
  End;

Function DecDays(D: TDateTime; Days: Integer; WorkingDays: TDayOfTheWeekSet;
    Holidays: Array of TDateTime): TDateTime; Overload;
  Begin
    Result := IncDays(D, -Days, WorkingDays, Holidays);
  End;