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

tvplanit/GanttView: Clip too-long row headers.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8542 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-10-12 12:36:21 +00:00
parent 4b311b656d
commit 7630af7726
2 changed files with 21 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -511,7 +511,6 @@ begin
for i := 0 to FGanttView.NumEvents-1 do
begin
eventRec := FGanttView.EventRecords[i];
str := eventRec.Caption;
R := ScaleRect(eventRec.HeadRect);
OffsetRect(R, 0, -dy);
if R.Top < FScaledTotalColHeaderHeight then
@ -531,10 +530,18 @@ begin
TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom);
end;
// Paint event description as header
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);
// Paint event description as header.
// Use clipping in case the text is too long
RenderCanvas.Clipping := true;
try
RenderCanvas.ClipRect := R;
inc(R.Left, FScaledTextMargin + 2);
P := Point(R.Left, (R.Top + R.Bottom - strH) div 2);
str := eventRec.Caption;
TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str);
finally
RenderCanvas.Clipping := false;
end;
end;
end;