pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit: Support recurring events in GanttView.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8543 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-10-12 16:40:15 +00:00
parent 7630af7726
commit 8f81cf7a6d
4 changed files with 271 additions and 93 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
components/tvplanit/source/vpconst.pas
View File

@ -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 }

3
components/tvplanit/source/vpdata.pas
View File

@ -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

330
components/tvplanit/source/vpganttview.pas
View File

@ -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
if FEventRecords[i].Event = AEvent then
for i := 0 to FEventRecords.Count-1 do
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;
try
// 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
// The EventRecords list is supposed to collect all events displayed by the
// GanttView.
FEventRecords.Free;
FEventRecords := TVpGanttEventList.Create(FRealStartDate, FRealEndDate);
// 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
list.Sort(@CompareEvents);
// Sort events by date/time - this is a general requirement for Gantt
FEventRecords.Sort(@CompareEventRecs);
// Prepare array for the event records simplifying work for the Gantt view
SetLength(FEventRecords, list.Count);
// Iterate over all considered events, fill the event record and store it
// 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
// in the array
xh1 := 0;
xh2 := FixedColWidth;
y1 := FTotalColHeaderHeight;
totalWidth := GetNumDays * ColWidth;
for i := 0 to list.Count-1 do
begin
event := TVpEvent(list[i]);
// Store event rectangle coordinates in the EventRec
y2 := y1 + FRowHeight;
xe1 := round((t1 - FRealStartDate) / numDays * totalWidth) + FixedColWidth;
xe2 := round((t2 - FRealStartDate) / numDays * totalWidth) + FixedColWidth;
if xe1 = xe2 then xe2 := xe1 + 1;
// Get start and end time of the event. Handle all-day-events correctly.
if event.AllDayEvent then
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;
eventRec^.HeadRect := Rect(xh1, y1, xh2, y2);
eventRec^.EventRect := Rect(xe1, y1, xe2, y2);
// The time range of events reaching out of the displayed date range
// must be clipped at the edges.
if t1 < FRealStartDate then
t1 := FRealStartDate;
if t2 > FRealEndDate + 1 then
t2 := FRealEndDate + 1;
// Find the active row. This is the row with the active event.
if eventRec^.Event = FActiveEvent then
FActiveRow := i;
// Store event, caption and its rectangle coordinates in the EventRec
y2 := y1 + FRowHeight;
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;
// Prepare for next row
y1 := y2;
end;
end;
@ -1638,8 +1816,8 @@ begin
dt := DayRecords[FActiveCol].Date;
dayRect := DayRecords[FActiveCol].Rect;
event := EventRecords[FActiveRow].Event;
eventRect := EventRecords[FActiveRow].EventRect;
event := EventRecords[FActiveRow]^.Event;
eventRect := EventRecords[FActiveRow]^.EventRect;
dayRect.Top := eventRect.Top;
dayRect.Bottom := eventRect.Bottom;
@ -1696,8 +1874,8 @@ begin
else
FActiveRow := AValue;
event := EventRecords[FActiveRow].Event;
eventRect := EventRecords[FActiveRow].EventRect;
event := EventRecords[FActiveRow]^.Event;
eventRect := EventRecords[FActiveRow]^.EventRect;
dt := DayRecords[FActiveCol].Date;
dayRect := DayRecords[FActiveCol].Rect;
dayRect.Top := eventRect.Top;

28
components/tvplanit/source/vpganttviewpainter.pas
View File

@ -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;
if event.EndTime < FGanttView.FirstDate then
event := eventRec^.Event;
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;