How to ensure dragged/resized allocations always start on the first day of a month and finish on the last day of a month.


Sometimes, you may want to ensure that allocations always start and/or finish at certain dates or times. For this example, we'll ensure that dragged and resized allocations always occupy a complete calendar month.

function MyEncodeDate(y, m, d: integer): TDateTime;
var
  dd: integer;
begin
  while (m < 1) do begin
    inc(m, 12);
    dec(y);
  end;
  while (m > 12) do begin
    dec(m, 12);
    inc(y);
  end;
  dd := d;
  if d = MaxInt then // want end of month
    dd := MonthDays[IsLeapYear(y), m];
  result := EncodeDate(y, m, dd);
  if d = MaxInt then
    result := result + 1; // +1 to get end of day
end;

procedure TForm1.RACAllocationDrag(Sender: TObject;
                             Resource: TssResource;
                             Allocation: TssResourceAllocation;
                             var StartDateTime,
                                 EndDateTime: TDateTime,
                             var AllowDrag: Boolean);
var
  ys, ms, ds: word;
  NextMonth, ThisMonth: TDateTime;
  md: integer;
begin
  // allocations must always start on first of month
  DecodeDate(StartDateTime, ys, ms, ds);
  if ds <> 1 then begin
    NextMonth := MyEncodeDate(ys, ms + 1, 1);
    ThisMonth := MyEncodeDate(ys, ms, 1);

    // duration in approximate months
    md := round((EndDateTime - StartDateTime)) div 28 - 1;

    // find the neareast month - ahead or not?
    if NextMonth - StartDateTime < StartDateTime - ThisMonth then begin
      StartDateTime := NextMonth;
      EndDateTime := MyEncodeDate(ys, ms + md + 1, MaxInt);
    end else begin
      StartDateTime := ThisMonth;
      EndDateTime := MyEncodeDate(ys, ms + md, MaxInt);
    end;
  end;
end;

procedure TForm1.RACAllocationStretch(Sender: TObject;
                             Resource: TssResource;
                             Allocation: TssResourceAllocation;
                             var StartDateTime,
                                 EndDateTime: TDateTime,
                             var AllowDrag: Boolean);
var
  y, m, d: word;
  md: integer;
begin
  // allocations must always start on first
  // of month and end on last of month
  DecodeDate(StartDateTime, y, m, d);
  md := MonthDays[IsLeapYear(y), m];
  if d <> 1 then begin
    // nearer to start of this month, or start of next?
    if d <= md div 2 then
      StartDateTime := MyEncodeDate(y, m, 1)
    else
      StartDateTime := MyEncodeDate(y, m + 1, 1);
  end;
  DecodeDate(EndDateTime - EncodeTime(0, 0, 0, 1), y, m, d);
  md := MonthDays[IsLeapYear(y), m];
  if d <> md then begin
    // nearer to end of this month, or end of next?
    if d <= md div 2 then
      EndDateTime := MyEncodeDate(y, m - 1, MaxInt)
    else
      EndDateTime := MyEncodeDate(y, m, MaxInt);
  end;
end;

Note: These event handlers can be invoked many times a second while the user is dragging or re-sizing an allocation. It is important that they complete quickly in order to maintain a responsive user experience.