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

Question

我正在使用Delphi 7.我不仅熟悉使用画布和绘制文本到画布,还使用TCanvas.TextHeight等.当我想实现Word Wrap时出现问题.我不仅需要以最佳方式将文本绘制到画布并使其自动换行到给定的宽度约束,而且还需要知道它被包装后的高度(或多少行).我需要在绘制文本之前准备另一个图像,这个图像需要足够大才能放置包装好的文本.这是尝试复制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(或减少rif S 恰好在一条线上的宽度;另外,如果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;

截图http://privat.rejbrand.se/DrawTextChat.png