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

tvplanit: Fix scaling of printed TaskList.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8514 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-10-06 11:01:31 +00:00
parent 37d4c4c837
commit 87cb6634be
1 changed files with 15 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
components/tvplanit/source/vptasklistpainter.pas
View File

@ -13,6 +13,7 @@ type
TVpTaskListPainter = class(TVpBasePainter)
private
FTaskList: TVpTaskList;
FScaledTextMargin: Integer;
// local parameters of the old TVpTaskList method
HeadRect: TRect;
@ -43,6 +44,7 @@ type
procedure FixFontHeights;
procedure InitColors;
procedure MeasureRowHeight;
procedure SetMeasurements; override;
public
constructor Create(ATaskList: TVpTaskList; ARenderCanvas: TCanvas);
@ -241,7 +243,7 @@ begin
HeadRect.Left := RealLeft + delta;
HeadRect.Top := RealTop + delta;
HeadRect.Right := RealRight - delta - 1;
HeadRect.Bottom := RealTop + hText + FTasklist.TextMargin * 2 - 1;
HeadRect.Bottom := RealTop + hText + FScaledTextMargin * 2 - 1;
TPSFillRect(RenderCanvas, Angle, RenderIn, HeadRect);
{ draw the header cell borders }
@ -272,7 +274,7 @@ begin
w := Round(bmp.Width * Scale);
h := Round(bmp.Height * Scale);
glyphRect.TopLeft := Point(
HeadRect.Left + FTasklist.TextMargin,
HeadRect.Left + FScaledTextMargin,
(HeadRect.Top + HeadRect.Bottom - h) div 2
);
glyphRect.BottomRight := Point(glyphRect.Left + w, glyphRect.Top + h);
@ -286,7 +288,7 @@ begin
bmp.Free;
end;
end else
textRect.Left := HeadRect.Left + FTaskList.TextMargin;
textRect.Left := HeadRect.Left + FScaledTextMargin;
{ draw the text }
with FTaskList do begin
@ -421,10 +423,10 @@ begin
// Adjust display string - If the string is too long for the available
// space, chop the end off and replace it with an ellipses.
DisplayStr := GetDisplayString(RenderCanvas, DisplayStr, 3, WidthOf(LineRect) - CheckRect.Right - TextMargin);
DisplayStr := GetDisplayString(RenderCanvas, DisplayStr, 3, WidthOf(LineRect) - CheckRect.Right - FScaledTextMargin);
// Paint the text
TPSTextOut(RenderCanvas, Angle, RenderIn, CheckRect.Right + TextMargin * 2, LineRect.Top + TextMargin, DisplayStr);
TPSTextOut(RenderCanvas, Angle, RenderIn, CheckRect.Right + FScaledTextMargin, LineRect.Top + FScaledTextMargin, DisplayStr);
// Store the tasks drawing details
tlVisibleTaskArray[tlVisibleItems].Task := task;
@ -439,7 +441,7 @@ begin
LineRect.Bottom := LineRect.Top + RowHeight;
Inc(tlVisibleItems);
end else
if (LineRect.Bottom - TextMargin > RealBottom) then begin
if (LineRect.Bottom - FScaledTextMargin > RealBottom) then begin
FLastPrintLine := I;
Break;
end;
@ -512,7 +514,7 @@ begin
{$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
{$ENDIF}
RowHeight := RenderCanvas.TextHeight(VpProductName) + FTasklist.TextMargin * 2;
RowHeight := RenderCanvas.TextHeight(VpProductName) + FScaledTextMargin * 2;
end;
procedure TVpTaskListPainter.RenderToCanvas(ARenderIn: TRect;
@ -562,4 +564,10 @@ begin
end;
end;
procedure TVpTaskListPainter.SetMeasurements;
begin
inherited;
FScaledTextMargin := round(FTaskList.Textmargin * Scale);
end;
end.