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

9
components/tvplanit/source/vpcanvasutils.pas
View File

@ -121,6 +121,7 @@ type
procedure BrushCopy(const Dest: TRect; Bitmap: TBitmap;
const Source: TRect; AColor: TColor);
procedure Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
procedure ClipRect(ARect: TRect);
procedure CopyRect(Dest: TRect; Canvas: TCanvas; const Source: TRect);
procedure Draw(X, Y: Integer; Graphic: TGraphic);
procedure DrawFocusRect(const ARect: TRect);
@ -918,6 +919,14 @@ begin
FCanvas.Chord(P1.X, P1.Y, P2.X, P2.Y, P3.X, P3.Y, P4.X, P4.Y);
end;
procedure TVpExCanvas.ClipRect(ARect: TRect);
begin
if not Assigned(FCanvas) then
raise EVpCanvasError.Create(RSNoCanvas);
FCanvas.ClipRect := TPSRotateRectangle(Angle, ViewPort, ARect);
end;
procedure TVpExCanvas.CopyRect(Dest: TRect; Canvas: TCanvas; const Source: TRect);
begin
if not Assigned(FCanvas) then

13
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
// 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);
TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, Str);
str := eventRec.Caption;
TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str);
finally
RenderCanvas.Clipping := false;
end;
end;
end;