Drawing outlined text #55

We can draw outlined and filled text providing we are using a vector font. The following routine draws text on a canvas and outlines it with the canvas' current pen and fills it with the current brush.

procedure DrawTextOutline(const Canvas: TCanvas; const X, Y: Integer;
  const Text: string);
var
  OldBkMode: Integer;  // stores previous background mode
begin
  OldBkMode := SetBkMode(Canvas.Handle, TRANSPARENT);
  BeginPath(Canvas.Handle);
  Canvas.TextOut(X, Y, Text);
  EndPath(Canvas.Handle);
  StrokeAndFillPath(Canvas.Handle);
  SetBkMode(Canvas.Handle, OldBkMode);
end;

First of all we set the background mode to transparent so that the bounding rectangle of the text is not filled with the canvas' current brush. Next we render the text as a Windows path (between BeginPath and EndPath API calls. If we left it at that nothing would be drawn on our canvas. The following call to StrokeAndFillPath outlines the path we have just created in the current pen and fills it with the current brush. Finally, the old background mode is restored.

Example

In this example we will display the text "Hello World!" in a large true type font and draw it with a dark blue dotted outline and a light blue hatched interior.

Start a new VCL application and create an OnPaint for the form as follows:

procedure TForm1.FormPaint(Sender: TObject);
const
  cText = 'Hello World!';
begin
  Canvas.Font.Name := 'Comic Sans MS';
  Canvas.Font.Style := [fsBold];
  Canvas.Font.Size := 48;
  Canvas.Brush.Color := clSkyBlue;  // $F0CAA6
  Canvas.Brush.Style := bsDiagCross;
  Canvas.Pen.Color := clNavy;
  Canvas.Pen.Style := psDot;
  DrawTextOutline(Canvas, 0, 0, cText);
end;

It looks a bit dull having a window-coloured background. We can change that by drawing the text twice. Change FormPaint as follows:

procedure TForm1.FormPaint(Sender: TObject);
const
  cText = 'Hello World!';
begin
  Canvas.Font.Name := 'Comic Sans MS';
  Canvas.Font.Style := [fsBold];
  Canvas.Font.Size := 48;
  // begin added code
  Canvas.Brush.Color := clWhite;
  Canvas.Pen.Style := psClear;
  DrawTextOutline(Canvas, 0, 0, cText);
  // end added code
  Canvas.Brush.Color := clSkyBlue;  // $F0CAA6
  Canvas.Brush.Style := bsDiagCross;
  Canvas.Pen.Color := clNavy;
  Canvas.Pen.Style := psDot;
  DrawTextOutline(Canvas, 0, 0, cText);
end;

Now we first paint the text with no border and a white background before overpainting the text with the dotted navy pen and light blue hatching.