tvplanit: Support recurring events in GanttView.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8543 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/tvplanit/source/vpconst.pas

@@ -63,6 +63,7 @@ const
 
   NO_DATE          = 9999999;
   FOREVER_DATE     = 999999;
+
   SecondsInDay     = 86400;   { Number of seconds in a day               }
   SecondsInHour    = 3600;    { Number of seconds in an hour             }
   SecondsInMinute  = 60;      { Number of seconds in a minute            }
@@ -72,6 +73,8 @@ const
   OneSecond        = 1.0 / SecondsInDay;
   OneMinute        = 1.0 / MinutesInDay;
   OneHour          = 1.0 / HoursInDay;
+  TIME_EPS         = 0.1 * OneSecond;  // Epsilon for comparing times
+
   MaxDateLen       = 40;      { maximum length of date picture strings   }
   MaxMonthName     = 15;      { maximum length for month names           }
   MaxDayName       = 15;      { maximum length for day names             }

components/tvplanit/source/vpdata.pas

@@ -729,9 +729,6 @@ uses
   VpException, VpConst, VpMisc, VpBaseDS, 
   VpImportPreview_ICalEvent, VpImportPreview_ICalTask, VpImportPreview_VCard;
 
-const
-  TIME_EPS = 1.0 / SecondsInDay;  // Epsilon for comparing times
-
 { Compare function for sorting resources: Compares the resource descriptions }
 function CompareResources(Item1, Item2: Pointer): Integer;
 begin

components/tvplanit/source/vpganttview.pas

@@ -28,9 +28,28 @@ type
   TVpGanttEventRec = record
     Event: TVpEvent;
     Caption: String;
+    StartTime, EndTime: TDateTime;
     HeadRect: TRect;
     EventRect: TRect;
   end;
+  PVpGanttEventRec = ^TVpGanttEventRec;
+
+  TVpGanttEventList = class(TFPList)
+  private
+    FStartDate, FEndDate: TDateTime;
+    function GetItem(AIndex: Integer): PVpGanttEventRec;
+    procedure SetItem(AIndex: Integer; AItem: PVpGanttEventRec);
+  protected
+    procedure ClipDates(AEventRec: PVpGanttEventRec);
+  public
+    constructor Create(AStartDate, AEndDate: TDateTime);
+    destructor Destroy; override;
+    function AddSingleEvent(AEvent: TVpEvent): PVpGanttEventRec;
+    procedure AddRecurringEvents(AEvent: TVpEvent);
+    procedure Clear;
+    procedure Delete(AIndex: Integer);
+    property Items[AIndex: Integer]: PVpGanttEventRec read GetItem write SetItem; default;
+  end;
 
   TVpGanttDayRec = record
     Date: TDateTime;
@@ -160,7 +179,7 @@ type
 
     function GetDateFormat(AIndex: Integer): String;
     function GetDayRec(AIndex: Integer): TVpGanttDayRec;
-    function GetEventRec(AIndex: Integer): TVpGanttEventRec;
+    function GetEventRec(AIndex: Integer): PVpGanttEventRec;
     function GetMonthRec(AIndex: Integer): TVpGanttMonthRec;
     function GetNumDays: Integer;
     function GetNumEvents: Integer;
@@ -191,7 +210,7 @@ type
 
   protected
     // Needed by the painter
-    FEventRecords: array of TVpGanttEventRec;
+    FEventRecords: TVpGanttEventList;
     FDayRecords: array of TVpGanttDayRec;
     FWeekRecords: array of TVpGanttWeekRec;
     FMonthRecords: array of TVpGanttMonthRec;
@@ -315,7 +334,7 @@ type
     property TotalColHeaderHeight: Integer read FTotalColHeaderHeight;
 
     property DayRecords[AIndex: Integer]: TVpGanttDayRec read GetDayRec;
-    property EventRecords[AIndex: Integer]: TVpGanttEventRec read GetEventRec;
+    property EventRecords[AIndex: Integer]: PVpGanttEventRec read GetEventRec;
     property MonthRecords[AIndex: Integer]: TVpGanttMonthRec read GetMonthRec;
     property WeekRecords[AIndex: Integer]: TVpGanttWeekRec read GetWeekRec;
 
@@ -372,6 +391,178 @@ const
   DEFAULT_MONTHFORMAT_SHORT = 'mmm yyyy';
   DEFAULT_COLWIDTH = 20;
 
+{ Compare function for sorting event records: Compares the start times of two events.
+  If the times are equal (within 1 seconds) then end times are compared.
+  The function is used by TVpGanttEventList.Sort. }
+function CompareEventRecs(Item1, Item2: Pointer): Integer;
+var
+  eventRec1, eventRec2: PVpGanttEventRec;
+begin
+  eventRec1 := PVpGanttEventRec(Item1);
+  eventRec2 := PVpGanttEventRec(Item2);
+  if SameValue(eventRec1^.StartTime, eventRec2^.StartTime, TIME_EPS) then
+    Result := CompareValue(eventRec1^.EndTime, eventRec2^.EndTime)
+  else
+    Result := CompareValue(eventRec1^.StartTime, eventRec2^.StartTime);
+end;
+
+{******************************************************************************}
+{   TVpGanttEventList                                                          }
+{******************************************************************************}
+constructor TVpGanttEventList.Create(AStartDate, AEndDate: TDateTime);
+begin
+  inherited Create;
+  FStartDate := AStartDate;
+  FEndDate := AEndDate;
+end;
+
+destructor TVpGanttEventList.Destroy;
+begin
+  Clear;
+  inherited;
+end;
+
+procedure TVpGanttEventList.AddRecurringEvents(AEvent: TVpEvent);
+var
+  eventRec: PVpGanttEventRec;
+  dt1, dt2: TDateTime;
+begin
+  if AEvent.AllDayEvent then
+  begin
+    dt1 := DatePart(AEvent.StartTime);
+    dt2 := DatePart(AEvent.EndTime) + 1;
+    if frac(AEvent.EndTime) = 0 then dt2 := dt2 + 1;
+  end else
+  begin
+    dt1 := AEvent.StartTime;
+    dt2 := AEvent.EndTime;
+  end;
+
+  while (DatePart(dt2) >= FStartDate) or (DatePart(dt1) <= FEndDate) do
+  begin
+    eventRec := AddSingleEvent(AEvent);
+    eventRec^.StartTime := dt1;
+    eventRec^.EndTime := dt2;
+    ClipDates(eventRec);
+
+    // Find date/times of next recurrance.
+    case AEvent.RepeatCode of
+      rtDaily:
+        begin
+          dt1 := dt1 + 1;
+          dt2 := dt2 + 1;
+        end;
+      rtWeekly:
+        begin
+          dt1 := dt1 + 7;
+          dt2 := dt2 + 7;
+        end;
+      rtMonthlyByDay:
+        begin
+          // wp: to do... What does it mean?
+        end;
+      rtMonthlyByDate:
+        begin
+          dt1 := IncMonth(dt1, 1);
+          dt2 := IncMonth(dt2, 1);
+        end;
+      rtYearlyByDay:
+        begin
+          // wp: to do... What does it mean?
+        end;
+      rtYearlyByDate:
+        begin
+          dt1 := IncYear(dt1, 1);
+          dt2 := IncYear(dt2, 1);
+        end;
+      rtCustom:
+        begin
+          dt1 := dt1 + AEvent.CustomInterval;
+          dt2 := dt2 + AEvent.CustomInterval;
+        end;
+    end;
+    if dt2 >= AEvent.RepeatRangeEnd then
+      break;
+  end;
+end;
+
+function TVpGanttEventList.AddSingleEvent(AEvent: TVpEvent): PVpGanttEventRec;
+var
+  eventRec: PVpGanttEventRec;
+  dt1, dt2: TDateTime;
+begin
+  // Handle the start/end times of all-day events correctly.
+  if AEvent.AllDayEvent then
+  begin
+    dt1 := DatePart(AEvent.StartTime);
+    dt2 := DatePart(AEvent.EndTime) + 1;
+    if frac(AEvent.EndTime) = 0 then dt2 := dt2 + 1;
+  end else
+  begin
+    dt1 := AEvent.StartTime;
+    dt2 := AEvent.EndTime;
+  end;
+
+  // Populate the event record
+  New(eventRec);
+  eventRec^ := Default(TVpGanttEventRec);
+  eventRec^.Event := AEvent;
+  eventRec^.Caption := AEvent.Description;
+  eventRec^.StartTime := dt1;
+  eventRec^.EndTime := dt2;
+  eventRec^.HeadRect := Rect(-1, -1, -1, -1);
+  eventRec^.EventRect := Rect(-1, -1, -1, -1);
+
+  ClipDates(eventRec);
+
+  Result := eventRec;
+
+  Add(Result);
+end;
+
+procedure TVpGanttEventList.Clear;
+var
+  eventRec: PVpGanttEventRec;
+  i: Integer;
+begin
+  for i := 0 to Count-1 do
+  begin
+    eventRec := GetItem(i);
+    Dispose(eventRec);
+  end;
+  inherited;
+end;
+
+procedure TVpGanttEventList.ClipDates(AEventRec: PVpGanttEventRec);
+begin
+  // The time range of events reaching out of the displayed date range
+  // must be clipped at the edges.
+  if AEventRec^.StartTime < FStartDate then
+    AEventRec^.StartTime := FStartDate;
+  if AEventRec^.EndTime > FEndDate + 1 then
+    AEventRec^.EndTime := FEndDate + 1;
+end;
+
+procedure TVpGanttEventList.Delete(AIndex: Integer);
+var
+  eventRec: PVpGanttEventRec;
+begin
+  eventRec := GetItem(AIndex);
+  Dispose(eventRec);
+  inherited;
+end;
+
+function TVpGanttEventList.GetItem(AIndex: Integer): PVpGanttEventRec;
+begin
+  Result := PVpGanttEventRec(inherited Items[AIndex]);
+end;
+
+procedure TVpGanttEventList.SetItem(AIndex: Integer; AItem: PVpGanttEventRec);
+begin
+  inherited Items[AIndex] := AItem;
+end;
+
+
 {******************************************************************************}
 {   TVpGanttHeaderAttributes                                                   }
 {******************************************************************************}
@@ -534,6 +725,7 @@ end;
 
 destructor TVpGanttView.Destroy;
 begin
+  FEventRecords.Free;
   FRowHeaderAttributes.Free;
   FColHeaderAttributes.Free;
   inherited;
@@ -790,10 +982,10 @@ var
 begin
   inherited;
 
-  if (FRowHeight > 0) and (Length(FEventRecords) > 0) then
+  if (FRowHeight > 0) and (FEventRecords.Count > 0) then
   begin
     VisibleRows := CalcVisibleRows(ClientHeight, FTotalColHeaderHeight, FRowHeight);
-    emptyRows := VisibleRows - (Length(FEventRecords) - FTopRow);
+    emptyRows := VisibleRows - (FEventRecords.Count - FTopRow);
     if emptyRows > 0 then
       ScrollVertical(-emptyRows);
 
@@ -852,7 +1044,7 @@ end;
 function TVpGanttView.GetEventAtCoord(X, Y: Integer): TVpEvent;
 var
   idx: Integer;
-  eventRec: TVpGanttEventRec;
+  eventRec: PVpGanttEventRec;
   dt: TDateTime;
 begin
   Result := nil;
@@ -863,13 +1055,13 @@ begin
   if (idx >= 0) and (idx < NumEvents) then
   begin
     eventRec := FEventRecords[idx];
-    Result := eventRec.Event;
+    Result := eventRec^.Event;
     if Result.AllDayEvent then
     begin
-      if (dt < DatePart(Result.StartTime)) or (dt > DatePart(Result.EndTime) + 1) then
+      if (dt < DatePart(eventRec^.StartTime)) or (dt > DatePart(eventRec^.EndTime) + 1) then
         Result := nil;
     end else
-      if (dt < Result.StartTime) or (dt > Result.EndTime) then
+      if (dt < eventRec^.StartTime) or (dt > eventRec^.EndTime) then
         Result := nil;
   end;
 end;
@@ -902,10 +1094,10 @@ end;
 
 function TVpGanttView.GetEventOfRow(ARow: Integer): TVpEvent;
 begin
-  Result := EventRecords[ARow].Event;
+  Result := EventRecords[ARow]^.Event;
 end;
 
-function TVpGanttView.GetEventRec(AIndex: Integer): TVpGanttEventRec;
+function TVpGanttView.GetEventRec(AIndex: Integer): PVpGanttEventRec;
 begin
   Result := FEventRecords[AIndex];
 end;
@@ -931,7 +1123,10 @@ end;
 { Determines the number of events (= rows) to be displayed in the GanttView. }
 function TVpGanttView.GetNumEvents: Integer;
 begin
-  Result := Length(FEventRecords);
+  if FEventRecords <> nil then
+    Result := FEventRecords.Count
+  else
+    Result := 0;
 end;
 
 { Determines the number of months (complete or partial) between the first and
@@ -1021,8 +1216,8 @@ function TVpGanttView.GetRowOfEvent(AEvent: TVpEvent): Integer;
 var
   i: Integer;
 begin
-  for i := 0 to High(FEventRecords) do
+  for i := 0 to FEventRecords.Count-1 do
-    if FEventRecords[i].Event = AEvent then
+    if FEventRecords[i]^.Event = AEvent then
     begin
       Result := i;
       exit;
@@ -1335,84 +1530,67 @@ end;
 procedure TVpGanttView.PopulateEventRecords;
 var
   event: TVpEvent;
+  eventRec: PVpGanttEventRec;
   i: Integer;
   xh1, xh2, y1, xe1, xe2, y2: Integer;
   t1, t2: TDateTime;
   totalWidth: Integer;
-  list: TFPList;
 begin
   if (Datastore = nil) or (DataStore.Resource = nil) then
     exit;
 
-  list := TFPList.Create;
+  // The EventRecords list is supposed to collect all events displayed by the
-  try
+  // GanttView.
-    // Consider only events which are, fully or partly, inside the
+  FEventRecords.Free;
-    // displayed date range between FRealStartDate and FRealEndDate
+  FEventRecords := TVpGanttEventList.Create(FRealStartDate, FRealEndDate);
-    for i := 0 to Datastore.Resource.Schedule.EventCount-1 do
+
+  // Consider only events which are, fully or partly, inside the
+  // displayed date range between FRealStartDate and FRealEndDate
+  for i := 0 to Datastore.Resource.Schedule.EventCount-1 do
+  begin
+    event := Datastore.Resource.Schedule.GetEvent(i);
+    if event.RepeatCode <> rtNone then
+      FEventRecords.AddRecurringEvents(event)
+    else
     begin
-      event := Datastore.Resource.Schedule.GetEvent(i);
       if DatePart(event.EndTime) < FRealStartDate then
         continue;
       if DatePart(event.StartTime) > FRealEndDate then
         continue;
-      list.Add(event);
+      FEventRecords.AddSingleEvent(event);
     end;
+  end;
 
-    // Sort events by date/time - this is a general requirement for Gantt
+  // Sort events by date/time - this is a general requirement for Gantt
-    list.Sort(@CompareEvents);
+  FEventRecords.Sort(@CompareEventRecs);
 
-    // Prepare array for the event records simplifying work for the Gantt view
+  // Iterate over all considered events, fill the event record and store it
-    SetLength(FEventRecords, list.Count);
+  // in the array
+  xh1 := 0;
+  xh2 := FixedColWidth;
+  y1 := FTotalColHeaderHeight;
+  totalWidth := GetNumDays * ColWidth;
+  for i := 0 to FEventRecords.Count-1 do
+  begin
+    eventRec := FEventRecords[i];
+    t1 := eventRec^.StartTime;
+    t2 := eventRec^.EndTime;
 
-    // Iterate over all considered events, fill the event record and store it
+    // Store event rectangle coordinates in the EventRec
-    // in the array
+    y2 := y1 + FRowHeight;
-    xh1 := 0;
+    xe1 := round((t1 - FRealStartDate) / numDays * totalWidth) + FixedColWidth;
-    xh2 := FixedColWidth;
+    xe2 := round((t2 - FRealStartDate) / numDays * totalWidth) + FixedColWidth;
-    y1 := FTotalColHeaderHeight;
+    if xe1 = xe2 then xe2 := xe1 + 1;
-    totalWidth := GetNumDays * ColWidth;
-    for i := 0 to list.Count-1 do
-    begin
-      event := TVpEvent(list[i]);
 
-      // Get start and end time of the event. Handle all-day-events correctly.
+    eventRec^.HeadRect := Rect(xh1, y1, xh2, y2);
-      if event.AllDayEvent then
+    eventRec^.EventRect := Rect(xe1, y1, xe2, y2);
-      begin
-        t1 := DatePart(event.StartTime);
-        t2 := DatePart(event.EndTime) + 1;
-        if frac(event.EndTime) = 0 then t2 := t2 + 1;
-      end else
-      begin
-        t1 := event.StartTime;
-        t2 := event.EndTime;
-      end;
 
-      // The time range of events reaching out of the displayed date range
+    // Find the active row. This is the row with the active event.
-      // must be clipped at the edges.
+    if eventRec^.Event = FActiveEvent then
-      if t1 < FRealStartDate then
+      FActiveRow := i;
-        t1 := FRealStartDate;
-      if t2 > FRealEndDate + 1 then
-        t2 := FRealEndDate + 1;
 
-      // Store event, caption and its rectangle coordinates in the EventRec
+    // Prepare for next row
-      y2 := y1 + FRowHeight;
+    y1 := y2;
-      xe1 := round((t1 - FRealStartDate) / numDays * totalWidth) + FixedColWidth;
-      xe2 := round((t2 - FRealStartDate) / numDays * totalWidth) + FixedColWidth;
-      if xe1 = xe2 then xe2 := xe1 + 1;
-      FEventRecords[i].Event := event;
-      FEventRecords[i].Caption := event.Description;
-      FEventRecords[i].HeadRect := Rect(xh1, y1, xh2, y2);
-      FEventRecords[i].EventRect := Rect(xe1, y1, xe2, y2);
-
-      // Find the active row. This is the row with the active event.
-      if event = FActiveEvent then
-        FActiveRow := i;
-
-      // Prepare for next row
-      y1 := y2;
-    end;
-
-  finally
-    list.Free;
   end;
 end;
 
@@ -1638,8 +1816,8 @@ begin
   dt := DayRecords[FActiveCol].Date;
   dayRect := DayRecords[FActiveCol].Rect;
 
-  event := EventRecords[FActiveRow].Event;
+  event := EventRecords[FActiveRow]^.Event;
-  eventRect := EventRecords[FActiveRow].EventRect;
+  eventRect := EventRecords[FActiveRow]^.EventRect;
   dayRect.Top := eventRect.Top;
   dayRect.Bottom := eventRect.Bottom;
 
@@ -1696,8 +1874,8 @@ begin
   else
     FActiveRow := AValue;
 
-  event := EventRecords[FActiveRow].Event;
+  event := EventRecords[FActiveRow]^.Event;
-  eventRect := EventRecords[FActiveRow].EventRect;
+  eventRect := EventRecords[FActiveRow]^.EventRect;
   dt := DayRecords[FActiveCol].Date;
   dayRect := DayRecords[FActiveCol].Rect;
   dayRect.Top := eventRect.Top;

components/tvplanit/source/vpganttviewpainter.pas

@@ -83,7 +83,7 @@ procedure TVpGanttViewPainter.DrawActiveDate;
 var
   R: TRect;
   dayRec: TVpGanttDayRec;
-  eventRec: TVpGanttEventRec;
+  eventRec: PVpGanttEventRec;
   dx, dy: Integer;
   bs: TBrushStyle;
   pw: Integer;
@@ -103,7 +103,7 @@ begin
   end;
 
   R := Rect(
-    dayRec.Rect.Left, eventRec.EventRect.Top, dayRec.Rect.Right, eventRec.EventRect.Bottom
+    dayRec.Rect.Left, eventRec^.EventRect.Top, dayRec.Rect.Right, eventRec^.EventRect.Bottom
   );
   OffsetRect(R, -dx, -dy);
 
@@ -273,7 +273,7 @@ end;
 procedure TVpGanttViewPainter.DrawEvents;
 var
   i: Integer;
-  eventRec: TVpGanttEventRec;
+  eventRec: PVpGanttEventRec;
   event: TVpEvent;
   cat: TVpCategoryInfo;
   R: TRect;
@@ -302,12 +302,12 @@ begin
   for i := 0 to FGanttView.NumEvents-1 do
   begin
     eventRec := FGanttView.EventRecords[i];
-    event := eventRec.Event;
+    event := eventRec^.Event;
-    if event.EndTime < FGanttView.FirstDate then
+    if eventRec^.EndTime < FGanttView.FirstDate then
       Continue;
-    if event.StartTime > FGanttView.LastDate + 1then
+    if eventRec^.StartTime > FGanttView.LastDate + 1then
       exit;
-    R := ScaleRect(eventRec.EventRect);
+    R := ScaleRect(eventRec^.EventRect);
     OffsetRect(R, -dx, -dy);
     inc(R.Top, top_margin);
     dec(R.Bottom, bottom_margin);
@@ -330,7 +330,7 @@ var
   x1, x2, y0, y1, y2: Integer;
   dx, dy: Integer;
   i, n, numEvents: Integer;
-  eventRec: TVpGanttEventRec;
+  eventRec: PVpGanttEventRec;
   dayRec: TVpGanttDayRec;
   monthRec: TVpGanttMonthRec;
   R: TRect;
@@ -364,7 +364,7 @@ begin
     for i := 0 to numEvents - 1 do
     begin
       eventRec := FGanttView.EventRecords[i];
-      R := ScaleRect(eventRec.EventRect);
+      R := ScaleRect(eventRec^.EventRect);
       y1 := y0 + R.Bottom;
       if y1 >= FScaledTotalColHeaderHeight then
       begin
@@ -381,7 +381,7 @@ begin
     if numEvents > 0 then
     begin
       eventRec := FGanttView.EventRecords[numEvents-1];
-      R := ScaleRect(eventRec.EventRect);
+      R := ScaleRect(eventRec^.EventRect);
       y2 := R.Bottom - dy;
       n := FGanttView.NumDays;
       for i := 0 to n-1 do
@@ -477,7 +477,7 @@ var
   str: String;
   i: Integer;
   dy: Integer;
-  eventRec: TVpGanttEventRec;
+  eventRec: PVpGanttEventRec;
 begin
   RenderCanvas.Brush.Color := RealRowHeadAttrColor;
 
@@ -511,7 +511,7 @@ begin
   for i := 0 to FGanttView.NumEvents-1 do
   begin
     eventRec := FGanttView.EventRecords[i];
-    R := ScaleRect(eventRec.HeadRect);
+    R := ScaleRect(eventRec^.HeadRect);
     OffsetRect(R, 0, -dy);
     if R.Top < FScaledTotalColHeaderHeight then
       Continue;
@@ -537,7 +537,7 @@ begin
       RenderCanvas.ClipRect := R;
       inc(R.Left, FScaledTextMargin + 2);
       P := Point(R.Left, (R.Top + R.Bottom - strH) div 2);
-      str := eventRec.Caption;
+      str := eventRec^.Caption;
       TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str);
     finally
       RenderCanvas.Clipping := false;
@@ -568,7 +568,7 @@ begin
     y1 := RealTop + FScaledTotalColHeaderHeight;
     if nEvents > 0 then
     begin
-      R := ScaleRect(EventRecords[nEvents-1].HeadRect);
+      R := ScaleRect(EventRecords[nEvents-1]^.HeadRect);
       y2 := R.Bottom - dy;
     end else
       y2 := y1;