diff --git a/components/tvplanit/source/vpcanvasutils.pas b/components/tvplanit/source/vpcanvasutils.pas
index 418486856..d3fc0a544 100644
--- a/components/tvplanit/source/vpcanvasutils.pas
+++ b/components/tvplanit/source/vpcanvasutils.pas
@@ -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
diff --git a/components/tvplanit/source/vpganttviewpainter.pas b/components/tvplanit/source/vpganttviewpainter.pas
index c2b3024c8..78155ec45 100644
--- a/components/tvplanit/source/vpganttviewpainter.pas
+++ b/components/tvplanit/source/vpganttviewpainter.pas
@@ -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;