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