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

tvplanit: Extend TVpGanttView such that it can be painted only over a given date interval.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8480 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-09-14 21:24:33 +00:00
parent 865c17f414
commit 6af3c25955
3 changed files with 152 additions and 115 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -89,8 +89,10 @@ type
FActiveDate: TDateTime; // Selected date
FFirstDate: TDateTime; // Date of the first event in the resource
FLastDate: TDateTime; // Date of the last event in the resource
FStartDate: TDateTime; // Date of the first event to be displayed/printed
FEndDate: TDateTime; // Date of the last event to be displayed/printed
FStartDate: TDateTime; // Date of the first event to be displayed/printed (0 = first event ever)
FEndDate: TDateTime; // Date of the last event to be displayed/printed (0 = last event ever)
FRealStartDate: TDate; // Date of the first event to be displayed/printed (0 replaced)
FRealEndDate: TDate; // Date of the last event to be displayed/printed (0 repalaced)
FLeftCol: Integer; // Index of the left-most day column
FTopRow: Integer; // Index of the top-most event row
@ -181,10 +183,11 @@ type
function GetDateTimeAtCoord(X: Integer): TDateTime;
function GetEventAtCoord(X, Y: Integer): TVpEvent;
function GetEventOfRow(ARow: Integer): TVpEvent;
procedure GetRealEventDateRange(out AStartDate, AEndDate: TDate);
function GetRowAtCoord(Y: Integer): Integer;
function GetRowOfEvent(AEvent: TVpEvent): Integer;
procedure GetEventDateRange;
function IsEventOnDate(AEvent: TVpEvent; ADate: TDateTime): Boolean;
procedure GetEventDateRange(out AFirstDate, ALastDate: TDate);
function IsEventOnDate(AEvent: TVpEvent; ADate: TDate): Boolean;
procedure Hookup;
procedure Populate;
procedure PopulateDayRecords;
@ -251,6 +254,7 @@ type
Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime;
StartLine, StopLine: Integer; UseGran: TVpGranularity;
DisplayOnly: Boolean); override;
procedure SetDateLimits(AStartDate, AEndDate: TDateTime);
{$IF VP_LCL_SCALING = 2}
procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
@ -261,16 +265,18 @@ type
{$ENDIF}
{$ENDIF}
// Methods to be called by painter
// Methods/properties used by painter. Not meant to be called by user.
function CalcVisibleCols(AWidth, AFixedColWidth, AColWidth: Integer): Integer;
function CalcVisibleRows(AHeight, AHeaderHeight, ARowHeight: Integer): Integer;
property FirstDate: TDateTime read FFirstDate;
property LastDate: TDateTime read FLastDate;
property RealStartDate: TDateTime read FRealStartDate;
property RealEndDate: TDateTime read FRealEndDate;
property ActiveCol: Integer read FActiveCol write SetActiveCol;
property ActiveEvent: TVpEvent read FActiveEvent write SetActiveEvent;
property ActiveDate: TDateTime read FActiveDate write SetActiveDate;
property ActiveRow: Integer read FActiveRow write SetActiveRow;
property FirstDate: TDateTime read FFirstDate;
property LastDate: TDateTime read FLastDate;
property StartDate: TDateTime read FStartDate write FStartDate;
property EndDate: TDateTime read FEndDate write FEndDate;
property ColCount: Integer read FColCount write FColCount;
@ -502,7 +508,7 @@ begin
if UseAsHint then begin
{ Usage as hint }
startDateStr := FormatDateTime(DATE_FORMAT, AEvent.StartTime);
if trunc(AEvent.StartTime) = trunc(AEvent.EndTime) then
if SameDate(AEvent.StartTime, AEvent.EndTime) then
endDateStr := ''
else
endDateStr := FormatDateTime(DATE_FORMAT, AEvent.EndTime);
@ -612,9 +618,7 @@ var
dt, startTime, endTime: TDateTime;
begin
inherited;
// dvClickTimer.Enabled := false;
FMouseDown := false;
//FDragging := false;
// If the mouse was pressed down in the client area, then select the cell.
if not Focused then
@ -626,15 +630,18 @@ begin
exit;
end;
// Is there an event at the clicked cell?
FActiveEvent := GetEventAtCoord(FMouseDownPoint.X, FMouseDownPoint.Y);
if (FActiveEvent <> nil) then
// yes: edit the event
SpawnEventEditDialog(False)
else
begin
// no: add a new event
dt := GetDateTimeAtCoord(FMouseDownPoint.X);
if dt <> NO_DATE then
begin
startTime := trunc(dt);
startTime := DatePart(dt);
endTime := startTime + 1.0;
ActiveEvent := Datastore.Resource.Schedule.AddEvent(
Datastore.GetNextID(EventsTableName),
@ -645,33 +652,6 @@ begin
end;
end;
FMouseDownPoint := Point(0, 0);
(*
if (Msg.XPos > dvRowHeadWidth - 9) and (Msg.YPos > dvColHeadHeight) then
begin
{ The mouse click landed inside the client area }
dvSetActiveRowByCoord(Point(Msg.XPos, Msg.YPos), True);
{ See if we hit an active event }
if (FActiveEvent <> nil) and (not ReadOnly) then begin
{ edit this event }
dvSpawnEventEditDialog(False);
end else if not ReadOnly then begin
if not CheckCreateResource then
Exit;
if (DataStore = nil) or (DataStore.Resource = nil) then
Exit;
{ otherwise, we must want to create a new event }
StartTime := trunc(FDisplayDate + ActiveCol)
+ dvLineMatrix[ActiveCol, ActiveRow].Time;
EndTime := StartTime + dvTimeIncSize * FRowLinesStep;
FActiveEvent := DataStore.Resource.Schedule.AddEvent(
DataStore.GetNextID(EventsTableName), StartTime, EndTime);
{ edit this new event }
dvSpawnEventEditDialog(True);
end;
end;
*)
end;
procedure TVpGanttView.DeleteActiveEvent(Prompt: Boolean);
@ -786,7 +766,7 @@ end;
function TVpGanttView.GetDateOfCol(ACol: Integer): TDateTime;
begin
Result := FStartDate + ACol;
Result := FRealStartDate + ACol;
end;
function TVpGanttView.GetDateTimeAtCoord(X: Integer): TDateTime;
@ -795,7 +775,7 @@ var
begin
days := (X - FixedColWidth) / FColWidth + FLeftCol;
if (days >= 0) and (days < NumDays) then
Result := FStartDate + days
Result := FRealStartDate + days
else
Result := NO_DATE;
end;
@ -827,7 +807,7 @@ begin
Result := eventRec.Event;
if Result.AllDayEvent then
begin
if (dt < trunc(Result.StartTime)) or (dt > trunc(Result.EndTime) + 1) then
if (dt < DatePart(Result.StartTime)) or (dt > DatePart(Result.EndTime) + 1) then
Result := nil;
end else
if (dt < Result.StartTime) or (dt > Result.EndTime) then
@ -837,8 +817,8 @@ end;
{ Determines the date when the earliest event starts, and the date when the
latest event ends.
Stores them in the internal variables FStartdate and FEndDate. }
procedure TVpGanttView.GetEventDateRange;
Stores them in the internal variables FFirstDate and FLastDate. }
procedure TVpGanttView.GetEventDateRange(out AFirstDate, ALastDate: TDate);
var
i: Integer;
event: TVpEvent;
@ -851,20 +831,15 @@ begin
end else
begin
event := Datastore.Resource.Schedule.GetEvent(0);
FFirstDate := trunc(event.StartTime);
FFirstDate := DatePart(event.StartTime);
FLastDate := -99999;
for i := 0 to Datastore.Resource.Schedule.EventCount-1 do
begin
event := Datastore.Resource.Schedule.GetEvent(i);
d := trunc(event.EndTime);
d := DatePart(event.EndTime);
if d > FLastDate then FLastDate := d;
end;
end;
if FStartDate = 0 then
FStartDate := FFirstDate;
if FEndDate = 0 then
FEndDate := FLastDate;
end;
function TVpGanttView.GetEventOfRow(ARow: Integer): TVpEvent;
@ -882,12 +857,12 @@ begin
Result := FMonthRecords[AIndex];
end;
{ Determines the number days between the first and last Gantt event. This is
{ Determines the number of days between the first and last Gantt event. This is
the number of day columns in the view. }
function TVpGanttView.GetNumDays: Integer;
begin
if (FStartDate <> NO_DATE) then
Result := trunc(FEndDate) - trunc(FStartDate) + 1
if (FRealStartDate <> NO_DATE) then
Result := trunc(FRealEndDate) - trunc(FRealStartDate) + 1
else
Result := 0;
end;
@ -895,10 +870,7 @@ end;
{ Determines the number of events (= rows) to be displayed in the GanttView. }
function TVpGanttView.GetNumEvents: Integer;
begin
if (Datastore <> nil) and (Datastore.Resource <> nil) then
Result := Datastore.Resource.Schedule.EventCount
else
Result := 0;
Result := Length(FEventRecords);
end;
{ Determines the number of months (complete or partial) between the first and
@ -908,10 +880,10 @@ var
y1, m1, d1: Word;
y2, m2, d2: Word;
begin
if (FStartDate <> NO_DATE) then
if (FRealStartDate <> NO_DATE) then
begin
DecodeDate(FStartDate, y1, m1, d1);
DecodeDate(FEndDate, y2, m2, d2);
DecodeDate(FRealStartDate, y1, m1, d1);
DecodeDate(FRealEndDate, y2, m2, d2);
if (y1 = y2) then
Result := m2 - m1 + 1
else
@ -920,6 +892,15 @@ begin
Result := 0;
end;
{ Calculates the first and last date to be displayed in the GanttView. This
is necessary because the properties StartDate and EndDate may be 0 which
means the very first/last event. }
procedure TVpGanttView.GetRealEventDateRange(out AStartDate, AEndDate: TDate);
begin
if FStartDate > 0 then AStartDate := DatePart(FStartDate) else AStartDate := FFirstDate;
if FEndDate > 0 then AEndDate := DatePart(FEndDate) else AEndDate := FLastDate;
end;
function TVpGanttView.GetRowAtCoord(Y: Integer): Integer;
begin
Result := (Y - FTotalColHeaderHeight) div FRowHeight + FTopRow;
@ -958,7 +939,8 @@ begin
CalcRowHeight;
CalcColHeaderHeight;
GetEventDateRange;
GetEventDateRange(FFirstDate, FLastDate);
GetRealEventDateRange(FRealStartDate, FRealEndDate);
FColCount := GetNumDays;
FRowCount := GetNumEvents;
@ -966,16 +948,18 @@ begin
PopulateMonthRecords;
PopulateEventRecords;
end;
function TVpGanttView.IsEventOnDate(AEvent: TVpEvent; ADate: TDateTime): Boolean;
{ Checks whether the specified date belongs to the specified event.
The function returns true if the event begins before or at the date and ends
at or after it. }
function TVpGanttView.IsEventOnDate(AEvent: TVpEvent; ADate: TDate): Boolean;
var
tEv1, tEv2: TDateTime;
dEv1, dEv2: TDate;
begin
if AEvent <> nil then
begin
tEv1 := trunc(AEvent.StartTime);
tEv2 := trunc(AEvent.EndTime);
Result := (tEv1 <= ADate) and (tEv2 >= ADate);
dEv1 := DatePart(AEvent.StartTime);
dEv2 := DatePart(AEvent.EndTime);
Result := (dEv1 <= ADate) and (ADate <= dEv2);
end else
Result := false;
end;
@ -1188,7 +1172,7 @@ begin
Rect(0, 0, Width, Height), // Paint Rectangle
ra0, // Rotation angle: none
1, // Scale
FStartDate, // Date
FActiveDate, // Date
-1, // Start At
-1, // End At
gr30Min, // Granularity
@ -1219,7 +1203,7 @@ begin
begin
x2 := x1 + ColWidth;
FDayRecords[i].Rect := Rect(x1, y1, x2, y2);
FDayRecords[i].Date := FStartDate + i;
FDayRecords[i].Date := FRealStartDate + i;
x1 := x2;
end;
end;
@ -1233,37 +1217,54 @@ var
totalWidth: Integer;
list: TFPList;
begin
SetLength(FEventRecords, GetNumEvents);
if (Datastore = nil) or (DataStore.Resource = nil) then
exit;
list := TFPList.Create;
try
// Sort events by date/time
// 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
list.Add(Datastore.Resource.Schedule.GetEvent(i));
begin
event := Datastore.Resource.Schedule.GetEvent(i);
if DatePart(event.EndTime) < FRealStartDate then
continue;
if DatePart(event.StartTime) > FRealEndDate then
continue;
list.Add(event);
end;
// Sort events by date/time - this is a general requirement for Gantt
list.Sort(@CompareEvents);
// 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 High(FEventRecords) do
for i := 0 to list.Count-1 do
begin
event := TVpEvent(list[i]);
// The time range of events reaching out of the displayed date range
// must be clipped at the edges.
t1 := IfThen(event.StartTime >= FRealStartDate, event.StartTime, FRealStartDate);
t2 := IfThen(event.EndTime <= FRealEndDate + 1, event.EndTime, FRealEndDate + 1);
if event.AllDayEvent then
begin
t1 := trunc(event.StartTime);
t2 := trunc(event.EndTime) + 1;
if frac(event.EndTime) = 0 then t2 := t2 + 1;
end else
begin
t1 := event.StartTime;
t2 := event.EndTime;
t1 := DatePart(t1);
t2 := DatePart(t2) + 1;
if TimePart(t2) = 0 then t2 := t2 + 1;
end;
// Store event, caption and its rectangle coordinates in the EventRec
y2 := y1 + FRowHeight;
xe1 := round((t1 - FStartDate) / numDays * totalWidth) + FixedColWidth;
xe2 := round((t2 - FStartDate) / numDays * totalWidth) + FixedColWidth;
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;
@ -1297,7 +1298,8 @@ begin
if n > 1 then
begin
dm := FStartDate;
// Date interval crosses one or more month boundaries
dm := FRealStartDate;
for i := 0 to n - 1 do
begin
if i = 0 then begin
@ -1305,11 +1307,11 @@ begin
dm := StartOfTheMonth(dm);
end else
if i = n-1 then
nDays := DayOf(FEndDate)
nDays := DayOf(FRealEndDate)
else
nDays := DaysInMonth(dm);
if dm + nDays > FEndDate then
nDays := trunc(FEndDate) - trunc(dm) + 1;
if dm + nDays > FRealEndDate then
nDays := trunc(FRealEndDate) - trunc(dm) + 1;
x2 := x1 + nDays * ColWidth;
FMonthRecords[i].Rect := Rect(x1, y1, x2, y2);
FMonthRecords[i].Date := dm;
@ -1318,10 +1320,11 @@ begin
end;
end else
begin
nDays := DayOf(FEndDate) - DayOf(FStartDate) + 1;
// Date interval is within the same month
nDays := DayOf(FRealEndDate) - DayOf(FRealStartDate) + 1;
x2 := x1 + nDays * ColWidth;
FMonthRecords[0].Rect := Rect(x1, y1, x2, y2);
FMonthRecords[0].Date := FStartDate;
FMonthRecords[0].Date := FRealStartDate;
end;
end;
@ -1342,6 +1345,20 @@ begin
end;
end;
procedure TVpGanttView.SetDateLimits(AStartDate, AEndDate: TDateTime);
var
oldDate: TDateTime;
begin
oldDate := FActiveDate;
FStartDate := AStartDate;
FEndDate := AEndDate;
Init;
FActiveDate := 0;
SetActiveDate(oldDate);
end;
{$IF VP_LCL_SCALING = 2}
procedure TVpGanttView.FixDesignFontsPPI(const ADesignTimePPI: Integer);
begin
@ -1371,26 +1388,26 @@ end;
procedure TVpGanttView.ScrollDateIntoView(ADate: TDateTime);
begin
if (FStartDate = 0) or (FStartDate = NO_DATE) then
if (FRealStartDate = 0) or (FRealStartDate = NO_DATE) then
exit;
if ADate < FStartDate then
if ADate < FRealStartDate then
begin
FStartDate := trunc(ADate);
FRealStartDate := DatePart(ADate);
FColCount := GetNumDays;
SetLeftCol(-MaxInt);
end else
if ADate > FEndDate then
if ADate > FRealEndDate then
begin
FEndDate := trunc(ADate);
FRealEndDate := DatePart(ADate);
FColCount := GetNumDays;
SetLeftCol(FColCount - 1 - FVisibleCols);
end else
if ADate < FStartDate + FLeftCol then
SetLeftCol(trunc(ADate) - trunc(FStartDate))
if ADate < FRealStartDate + FLeftCol then
SetLeftCol(trunc(ADate) - trunc(FRealStartDate))
else
if ADate > FStartDate + VisibleCols then
SetLeftCol(trunc(ADate) - VisibleCols)
if ADate > FRealStartDate + FVisibleCols then
SetLeftCol(trunc(ADate) - FVisibleCols)
else
exit;
Invalidate;
@ -1446,14 +1463,14 @@ end;
procedure TVpGanttView.SetActiveDate(AValue: TDateTime);
begin
if FActiveDate <> trunc(AValue) then begin
FActiveDate := trunc(AValue);
if FActiveDate <> DatePart(AValue) then begin
FActiveDate := DatePart(AValue);
if FLoaded then
Populate;
ScrollDateIntoView(FActiveDate);
FActiveCol := trunc(FActiveDate) - trunc(FStartDate);
FActiveCol := trunc(FActiveDate) - trunc(FRealStartDate);
Invalidate;
if (not FInLinkHandler) and (ControlLink <> nil) then
@ -1871,7 +1888,7 @@ begin
Exit;
// Create the new event as an all-day event for the clicked day.
startTime := trunc(FActiveDate);
startTime := DatePart(FActiveDate);
endTime := startTime + 1 - OneMilliSecond;
FActiveEvent := DataStore.Resource.Schedule.AddEvent(
DataStore.GetNextID(EventsTableName),

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

@ -333,6 +333,10 @@ begin
begin
eventRec := FGanttView.EventRecords[i];
event := eventRec.Event;
if event.EndTime < FGanttView.FirstDate then
Continue;
if event.StartTime > FGanttView.LastDate then
exit;
R := ScaleRect(eventRec.EventRect);
OffsetRect(R, -dx, -dy);
inc(R.Top, top_margin);
@ -409,18 +413,17 @@ begin
eventRec := FGanttView.EventRecords[numEvents-1];
R := ScaleRect(eventRec.EventRect);
y2 := R.Bottom - dy;
end else
y2 := RealBottom;
n := FGanttView.NumDays;
for i := 0 to n-1 do
begin
dayRec := FGanttView.DayRecords[i];
R := ScaleRect(dayRec.Rect);
x1 := R.Right - dx;
if x1 >= FScaledFixedColWidth then
n := FGanttView.NumDays;
for i := 0 to n-1 do
begin
TPSMoveTo(RenderCanvas, Angle, RenderIn, x1, y1);
TPSLineTo(RenderCanvas, Angle, RenderIn, x1, y2)
dayRec := FGanttView.DayRecords[i];
R := ScaleRect(dayRec.Rect);
x1 := R.Right - dx;
if x1 >= FScaledFixedColWidth then
begin
TPSMoveTo(RenderCanvas, Angle, RenderIn, x1, y1);
TPSLineTo(RenderCanvas, Angle, RenderIn, x1, y2)
end;
end;
end;
end;
@ -507,7 +510,7 @@ var
begin
with FGanttView do
begin
if (StartDate = NO_DATE) or (SpecialDayMode <> sdmColumn) then
if (RealStartDate = NO_DATE) or (SpecialDayMode <> sdmColumn) then
exit;
nEvents := NumEvents;
@ -515,9 +518,13 @@ begin
dx := LeftCol * FScaledColWidth;
dy := TopRow * FScaledRowHeight;
R := ScaleRect(EventRecords[nEvents-1].HeadRect);
y1 := RealTop + FScaledTotalColHeaderHeight;
y2 := R.Bottom - dy;
if nEvents > 0 then
begin
R := ScaleRect(EventRecords[nEvents-1].HeadRect);
y2 := R.Bottom - dy;
end else
y2 := y1;
RenderCanvas.Brush.style := bsSolid;
for i := 0 to nDays-1 do

13
components/tvplanit/source/vpmisc.pas
View File

@ -146,6 +146,9 @@ function DaysInAMonth(Year, Month: Integer): Integer;
{-return the number of days in the specified month of a given year}
{$ENDIF}{$ENDIF}
function DatePart(ADateTime: TDateTime): TDateTime; inline;
function TimePart(ADateTime: TDateTime): TDateTime; inline;
function GetJulianDate(Date: TDateTime): Word;
function GetWeekOfYear(ADate: TDateTime): byte;
function IsWeekend(ADate: TDateTime): Boolean;
@ -710,6 +713,16 @@ begin
end;
{$ENDIF}{$ENDIF}
function DatePart(ADateTime: TDateTime): TDateTime;
begin
Result := trunc(ADateTime);
end;
function TimePart(ADateTime: TDateTime): TDateTime;
begin
Result := frac(ADateTime);
end;
function GetJulianDate(Date: TDateTime): Word;
var
y, m, d, I: word;