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

tvplanit: Support printing of TVpGanttView.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8460 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-09-07 22:20:13 +00:00
parent 1122864942
commit e435fdb67d
2 changed files with 131 additions and 72 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -17,6 +17,12 @@ type
FMonthFont: TFont;
FEventFont: TFont;
FScaledColWidth: Integer;
FScaledFixedColWidth: Integer;
FScaledTextMargin: Integer;
FScaledTotalColHeaderHeight: Integer;
FScaledRowHeight: Integer;
BevelHighlight: TColor;
BevelShadow: TColor;
BevelDarkShadow: TColor;
@ -26,6 +32,8 @@ type
RealLineColor: TColor;
RealRowHeadAttrColor: TColor;
function ScaleRect(ARect: TRect): TRect;
protected
procedure Clear;
procedure DrawActiveDate;
@ -86,8 +94,8 @@ begin
dayRec := DayRecords[ActiveCol];
eventRec := EventRecords[ActiveRow];
dx := LeftCol * ColWidth;
dy := TopRow * RowHeight;
dx := LeftCol * FScaledColWidth;
dy := TopRow * FScaledRowHeight;
end;
R := Rect(
@ -95,7 +103,7 @@ begin
);
OffsetRect(R, -dx, -dy);
if R.Top < FGanttView.TotalColHeaderHeight then
if R.Top < FScaledTotalColHeaderHeight then
exit;
pw := RenderCanvas.Pen.Width;
@ -141,22 +149,22 @@ begin
RenderCanvas.Brush.Color := RealColHeadAttrColor;
RenderCanvas.Pen.Color := RealLineColor;
R := Rect(RealLeft, RealTop, RealRight, FGanttView.TotalColHeaderHeight);
R := Rect(RealLeft, RealTop, RealRight, RealTop + FScaledTotalColHeaderHeight);
TPSFillRect(RenderCanvas, Angle, RenderIn, R);
if FGanttView.DrawingStyle = ds3D then
begin
R1 := R;
InflateRect(R1, -1, -1);
R1.Right := FGanttView.FixedColWidth-1;
R1.Right := RealLeft + FScaledFixedColWidth - 1;
DrawBevelRect(
RenderCanvas,
TPSRotateRectangle(Angle, RenderIn, R1),
BevelHighlight,
BevelShadow
);
R1.Left := FGanttView.FixedColWidth;
R1.Right := RealRight-2;
R1.Left := RealLeft + FScaledFixedColWidth;
R1.Right := RealRight - 2;
DrawBevelRect(
RenderCanvas,
TPSRotateRectangle(Angle, RenderIn, R1),
@ -165,14 +173,14 @@ begin
);
end else
begin
TPSMoveTo(RenderCanvas, Angle, RenderIn, FGanttView.FixedColWidth, R.Top);
TPSLineTo(RenderCanvas, Angle, RenderIn, FGanttView.FixedColWidth, R.Bottom);
TPSMoveTo(RenderCanvas, Angle, RenderIn, RealLeft + FScaledFixedColWidth, R.Top);
TPSLineTo(RenderCanvas, Angle, RenderIn, RealLeft + FScaledFixedColWidth, R.Bottom);
TPSMoveTo(RenderCanvas, Angle, RenderIn, RealLeft, R.Bottom);
TPSLineTo(RenderCanvas, Angle, RenderIn, RealRight, R.Bottom);
end;
// Offset due to scrolling
dx := FGanttView.LeftCol * FGanttView.ColWidth;
dx := FGanttView.LeftCol * FScaledColWidth;
// Draw month rectangles and month captions
RenderCanvas.Font.Assign(FMonthFont);
@ -181,11 +189,12 @@ begin
begin
monthRec := FGanttView.MonthRecords[i];
R := monthRec.Rect;
R := ScaleRect(R);
OffsetRect(R, -dx , 0);
// Clip at fixed col edge
if R.Left < FGanttView.FixedColWidth then
R.Left := FGanttView.FixedColWidth;
if R.Left < RealLeft + FScaledFixedColWidth then
R.Left := RealLeft + FScaledFixedColWidth;
// Draw month box
if FGanttView.DrawingStyle = ds3D then
@ -209,16 +218,16 @@ begin
// Paint month name. Use short format if space is too small for long format.
str := FormatDateTime(FGanttView.MonthFormat, monthRec.Date);
strLen := RenderCanvas.TextWidth(str);
if strLen > R.Width - 2 * FGanttView.TextMargin then
if strLen > R.Width - 2 * FScaledTextMargin then
begin
str := FormatDateTime(FGanttView.MonthFormat_short, monthRec.Date);
strLen := RenderCanvas.TextWidth(str);
end;
if strLen > R.Width - 2 * FGanttView.TextMargin then
if strLen > R.Width - 2 * FScaledTextMargin then
str := '';
if str <> '' then
begin
P := Point((R.Left + R.Right - strLen) div 2, R.Top + FGanttView.TextMargin);
P := Point((R.Left + R.Right - strLen) div 2, R.Top + FScaledTextMargin);
TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str);
end;
end;
@ -230,9 +239,9 @@ begin
for i := 0 to n - 1 do
begin
dayRec := FGanttView.DayRecords[i];
R := dayRec.Rect;
R := ScaleRect(dayRec.Rect);
OffsetRect(R, -dx, 0);
if R.Left < FGanttView.FixedColWidth then
if R.Left < RealLeft + FScaledFixedColWidth then
Continue;
// In sdmHeader SpecialDayMode we must repaint the background of the
@ -301,9 +310,14 @@ var
dx, dy: Integer;
top_margin, bottom_margin: Integer;
begin
dx := FGanttView.LeftCol * FGanttView.ColWidth;
dy := FGanttView.TopRow * FGanttView.RowHeight;
dx := FGanttView.LeftCol * FScaledColWidth;
dy := FGanttView.TopRow * FScaledRowHeight;
if DisplayOnly then
begin
top_margin := round(2*scale);
bottom_margin := top_margin;
end else
if FGanttView.DrawingStyle = ds3D then
begin
top_margin := 1;
@ -313,23 +327,25 @@ begin
top_margin := 2;
bottom_margin := 1;
end;
RenderCanvas.Font.Assign(FEventFont);
for i := 0 to FGanttView.NumEvents-1 do
begin
eventRec := FGanttView.EventRecords[i];
event := eventRec.Event;
R := eventRec.EventRect;
R := ScaleRect(eventRec.EventRect);
OffsetRect(R, -dx, -dy);
inc(R.Top, top_margin);
dec(R.Bottom, bottom_margin);
if R.Top < FGanttView.TotalColHeaderHeight then
if R.Top < FScaledTotalColHeaderHeight then
Continue;
if R.Right < FGanttView.FixedColWidth then
if R.Right < FScaledFixedColWidth then
Continue;
if R.Left < FGanttView.FixedColWidth then
R.Left := FGanttView.FixedColWidth;
if R.Left < FScaledFixedColWidth then
R.Left := FScaledFixedColWidth;
cat := FGanttView.DataStore.CategoryColorMap.GetCategory(event.Category);
RenderCanvas.Pen.Color := cat.Color;
RenderCanvas.Pen.Width := round(Scale);
RenderCanvas.Brush.Color := cat.BackgroundColor;
TPSRectangle(RenderCanvas, Angle, RenderIn, R);
end;
@ -343,24 +359,27 @@ var
eventRec: TVpGanttEventRec;
dayRec: TVpGanttDayRec;
monthRec: TVpGanttMonthRec;
R: TRect;
begin
RenderCanvas.Pen.Color := RealLineColor;
dx := FGanttView.LeftCol * FGanttView.ColWidth;
dy := FGanttView.TopRow * FGanttView.RowHeight;
dx := FGanttView.LeftCol * FScaledColWidth;
dy := FGanttView.TopRow * FScaledRowHeight;
// Horizontal line terminating the col header block
x1 := RealLeft + FGanttView.FixedColWidth;
x1 := RealLeft + FScaledFixedColWidth;
n := FGanttView.NumMonths;
if n > 0 then
begin
monthRec := FGanttView.MonthRecords[n-1];
x2 := monthRec.Rect.Right - dx;
R := ScaleRect(monthRec.Rect);
x2 := R.Right - dx;
end else
x2 := RealRight;
y0 := FGanttView.TotalColHeaderHeight;
y0 := RealTop + FScaledTotalColHeaderHeight;
if FGanttView.DrawingStyle = ds3D then dec(y0);
RenderCanvas.Line(x1, y0, x2, y0);
TPSMoveTo(RenderCanvas, Angle, RenderIn, x1, y0);
TPSLineTo(RenderCanvas, Angle, RenderIn, x2, y0);
// Horizontal lines
if (gvoHorizGrid in FGanttView.Options) then
@ -371,30 +390,38 @@ begin
for i := 0 to numEvents - 1 do
begin
eventRec := FGanttView.EventRecords[i];
y1 := y0 + eventRec.EventRect.Bottom;
if y1 >= FGanttView.TotalColHeaderHeight then
RenderCanvas.Line(x1, y1, x2, y1);
R := ScaleRect(eventRec.EventRect);
y1 := y0 + R.Bottom;
if y1 >= FScaledTotalColHeaderHeight then
begin
TPSMoveTo(RenderCanvas, Angle, RenderIn, x1, y1);
TPSLineTo(RenderCanvas, Angle, RenderIn, x2, y1);
end;
end;
end;
// Vertical lines
if (gvoVertGrid in FGanttView.Options) then
begin
y1 := RealTop + FGanttView.TotalColHeaderHeight;
y1 := RealTop + FScaledTotalColHeaderHeight;
if numEvents > 0 then
begin
eventRec := FGanttView.EventRecords[numEvents-1];
y2 := eventRec.EventRect.Bottom - dy;
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];
x1 := dayRec.Rect.Right - dx;
x2 := x1;
if x1 >= FGanttView.FixedColWidth then
RenderCanvas.Line(x1, y1, x2, y2);
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;
@ -414,7 +441,7 @@ begin
if FGanttView.DrawingStyle = ds3d then begin
R.Left := RealLeft + 1;
R.Top := RealTop;
R.Right := RealLeft + FGanttView.FixedColWidth - 1;
R.Right := RealLeft + FScaledFixedColWidth - 1;
R.Bottom := RealBottom - 1;
TPSFillRect(RenderCanvas, Angle, RenderIn, R);
DrawBevelRect(
@ -424,10 +451,11 @@ begin
BevelShadow
);
end else begin
R := Rect(RealLeft, RealTop + 1, RealLeft + FGanttView.FixedColWidth, RealBottom);
R := Rect(RealLeft, RealTop + 1, RealLeft + FScaledFixedColWidth, RealBottom);
TPSFillRect(RenderCanvas, Angle, RenderIn, R);
RenderCanvas.Pen.Color := RealLineColor;
RenderCanvas.Line(R.Right, R.Top, R.Right, R.Bottom);
TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top);
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom);
end;
RenderCanvas.Font.Assign(FEventFont);
@ -435,15 +463,15 @@ begin
RenderCanvas.Pen.Color := RealLineColor;
// Offset due to scrolling
dy := FGanttView.TopRow * FGanttView.RowHeight;
dy := FGanttView.TopRow * FScaledRowHeight;
for i := 0 to FGanttView.NumEvents-1 do
begin
eventRec := FGanttView.EventRecords[i];
str := eventRec.Caption;
R := eventRec.HeadRect;
R := ScaleRect(eventRec.HeadRect);
OffsetRect(R, 0, -dy);
if R.Top < FGanttView.TotalColHeaderHeight then
if R.Top < FScaledTotalColHeaderHeight then
Continue;
if FGanttView.DrawingStyle = ds3D then
begin
@ -456,11 +484,12 @@ begin
);
end else
begin
RenderCanvas.Line(R.Left, R.Bottom, R.Right, R.Bottom);
TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Left, R.Bottom);
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom);
end;
// Paint event description as header
inc(R.Left, FGanttView.TextMargin + 2);
inc(R.Left, FScaledTextMargin + 2);
P := Point(R.Left, (R.Top + R.Bottom - strH) div 2);
TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, Str);
end;
@ -474,6 +503,7 @@ var
clr: TColor;
dayRec: TVpGanttDayRec;
holiday: String;
R: TRect;
begin
with FGanttView do
begin
@ -482,11 +512,12 @@ begin
nEvents := NumEvents;
nDays := NumDays;
dx := LeftCol * ColWidth;
dy := TopRow * RowHeight;
dx := LeftCol * FScaledColWidth;
dy := TopRow * FScaledRowHeight;
y1 := TotalColHeaderHeight;
y2 := EventRecords[nEvents-1].HeadRect.Bottom - dy;
R := ScaleRect(EventRecords[nEvents-1].HeadRect);
y1 := RealTop + FScaledTotalColHeaderHeight;
y2 := R.Bottom - dy;
RenderCanvas.Brush.style := bsSolid;
for i := 0 to nDays-1 do
@ -501,8 +532,9 @@ begin
if clr <> clNone then
begin
RenderCanvas.Brush.Color := clr;
x1 := dayRec.Rect.Left - dx;
x2 := dayRec.Rect.Right - dx;
R := ScaleRect(dayRec.Rect);
x1 := R.Left - dx;
x2 := R.Right - dx;
RenderCanvas.FillRect(x1, y1, x2, y2);
end;
end;
@ -595,17 +627,30 @@ begin
{ Restore canvas settings}
RestorePenBrush;
end;
//RenderCanvas.Textout(0, 0, FormatDateTime('c', ARenderDate));
//RenderCanvas.TextOut(0, 20, FormatDateTime('c', FGanttView.Date));
function TVpGanttViewPainter.ScaleRect(ARect: TRect): TRect;
begin
Result.Left := RealLeft + round(ARect.Left * Scale);
Result.Top := RealTop + round(ARect.Top * Scale);
Result.Right := RealLeft + round(ARect.Right * Scale);
Result.Bottom := RealTop + round(ARect.Bottom * Scale);
end;
procedure TVpGanttViewPainter.SetMeasurements;
begin
inherited;
FGanttView.Init;
FGanttView.VisibleCols := FGanttView.CalcVisibleCols(RealRight - RealLeft);
FGanttView.VisibleRows := FGanttView.CalcVisibleRows(RealBottom - RealTop);
FScaledFixedColWidth := round(FGanttView.FixedColWidth * Scale);
FScaledColWidth := round(FGanttView.ColWidth * Scale);
FScaledTextMargin := round(FGanttView.TextMargin * Scale);
FScaledTotalColHeaderHeight := round(FGanttView.TotalColHeaderHeight * Scale);
FScaledRowHeight := round(FGanttView.RowHeight * Scale);
FGanttView.VisibleCols := FGanttView.CalcVisibleCols(RealRight - RealLeft, FScaledFixedColWidth, FScaledColWidth);
FGanttView.VisibleRows := FGanttView.CalcVisibleRows(RealBottom - RealTop, FScaledTotalColHeaderHeight, FScaledRowHeight);
end;
end.