在绘制到画布之前计算文本大小

Question

我正在使用 Delphi 7。我非常熟悉使用画布和在画布上绘制文本，以及使用 TCanvas.TextHeight 等。当我想实现自动换行时，问题就出现了。我不仅需要将文本绘制到画布上并自动换行到给定宽度约束的最佳方法，而且还需要知道换行后文本的高度（或多少行）。在绘制文本之前，我需要准备另一张图像，该图像需要足够大才能放置换行的文本。这是一次尝试复制 iPhone 显示 SMS 消息的方式，在屏幕两侧的可变高度滚动框中有一个气球（TScrollingWinControl 是我的基础）。

Answer 1

使用（几乎）万能的 DrawText 函数使用初始矩形和标志 DT_WORDBREAK （意味着字符串应该自动换行）和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;

由于DT_CALCRECT标志，第一个DrawText不会绘制任何东西，而只会改变r的高度> 以便它可以包含整个字符串 S （或者如果 S 恰好适合单行，则减小 r 的宽度；另外，如果 S 包含一个不包含的单词适合单行，r 的宽度将增加）。然后你就可以用r做任何你想做的事情，然后你就可以真正绘制字符串了。

尝试一下，例如：

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;