Calculating size of text before drawing to a canvas

Question

I'm using Delphi 7. I'm more than familiar with using a canvas and drawing text to a canvas, and also using TCanvas.TextHeight etc. The problem arises when I want to implement Word Wrap. Not only do I need the best way to draw text to a canvas and have it automatically wrap to a given width constraint, but I also need to know how high (or how many lines) it will be after it's wrapped. I need to prepare another image before I draw the text, an image which needs to be just big enough to place the wrapped text. This is an attempt to replicate how an iPhone displays SMS messages, with a baloon on either side of the screen in a variable height scrolling box (TScrollingWinControl is my base).

Solution

Use the (almost) omnipotent DrawText function using an initial rectangle, and the flags DT_WORDBREAK (meaning that the string should be word-wrapped) and DT_CALCRECT:

procedure TForm1.FormPaint(Sender: TObject);
const
  S = 'This is a sample text, I think, is it not?';
var
  r: TRect;
begin
  r := Rect(10, 10, 60, 60);
  DrawText(Canvas.Handle,
    PChar(S),
    Length(S),
    r,
    DT_LEFT or DT_WORDBREAK or DT_CALCRECT);

  DrawText(Canvas.Handle,
    PChar(S),
    Length(S),
    r,
    DT_LEFT or DT_WORDBREAK);
end;

Due to the flag DT_CALCRECT, the first DrawText will not draw anything, but only alter the height of r so that it can contain the entire string S (or reduce the width of r if S happens to fit on a single line; in addition, if S contains a word that does not fit on a single line, the width of r will be increased). Then you can do whatever you wish with r, and then you can draw the string for real.

Try this, for example:

procedure TForm1.FormPaint(Sender: TObject);
const
  S: array[0..3] of string = ('Hi! How are you?',
    'I am fine, thanks. How are you? How are your kids?',
    'Fine!',
    'Glad to hear that!');
  Colors: array[boolean] of TColor = (clMoneyGreen, clSkyBlue);
  Aligns: array[boolean] of integer = (DT_RIGHT, DT_LEFT);
var
  i, y, MaxWidth, RectWidth: integer;
  r, r2: TRect;
begin

  y := 10;
  MaxWidth := ClientWidth div 2;

  for i := low(S) to high(S) do
  begin

    Canvas.Brush.Color := Colors[Odd(i)];

    r := Rect(10, y, MaxWidth, 16);
    DrawText(Canvas.Handle,
      PChar(S[i]),
      Length(S[i]),
      r,
      Aligns[Odd(i)] or DT_WORDBREAK or DT_CALCRECT);

    if not Odd(i) then
    begin
      RectWidth := r.Right - r.Left;
      r.Right := ClientWidth - 10;
      r.Left := r.Right - RectWidth;
    end;

    r2 := Rect(r.Left - 4, r.Top - 4, r.Right + 4, r.Bottom + 4);
    Canvas.RoundRect(r2, 5, 5);

    DrawText(Canvas.Handle,
      PChar(S[i]),
      Length(S[i]),
      r,
      Aligns[Odd(i)] or DT_WORDBREAK);

    y := r.Bottom + 10;

  end;

end;

procedure TForm1.FormResize(Sender: TObject);
begin
  Invalidate;
end;

Comments

[David Heffernan]

Use DrawText and let the system do the word wrapping

[Server Overflow]

Hi Andreas - Great answer as usual!