Рисование многострочного текста BitMap

[Puhovoi]

Доброго времени суток!

Стоит задача выводить на произвольной ширины битмапе текст. Текст может быть длиннее, чем ширина битмапа. Нужен алгоритм, который выводит текст, разбивая его на строки (если в одну строку не влезает) и центруя.

Если у кого-то завалялся такой алгоритм - буду признателен.

Заранее спасибо за ответы.

[kangreon]

В WinApi есть функция, которая умеет делать все, что вы перечислили. Название точно не помню. Сейчас попробую поиска.

UPD

Ага. В классе TCanvas есть метод TextRect, у которого есть параметр TextFormat. Это обертка над функцией DrawTextEx.

  TTextFormats = (tfBottom, tfCalcRect, tfCenter, tfEditControl, tfEndEllipsis,
    tfPathEllipsis, tfExpandTabs, tfExternalLeading, tfLeft, tfModifyString,
    tfNoClip, tfNoPrefix, tfRight, tfRtlReading, tfSingleLine, tfTop,
    tfVerticalCenter, tfWordBreak, tfHidePrefix, tfNoFullWidthCharBreak,
    tfPrefixOnly, tfTabStop, tfWordEllipsis, tfComposited);

И описание самой функции DrawTextEx (рус)

[Puhovoi]

Благодарю, воспользовался DrawText. Но батюшки, как же она тормозит (рисование на канве десяти строк текста - 200 мс. в среднем).

[kangreon]

Странно, что тормозит. Я тут набросал процедуру, выводящую текст в рамку с выравниванием по центру. Рисует текст на форме, в событии OnPaint, мнгновенно. TDateTime показывает 0.000-0.015. Попробуйте ее.

procedure TForm1.DrawRectEx(const Canvas: TCanvas; const Rect: TRect;
  Text: string);
var
  i, oldWidth, Width: Integer;
  PoleWidth, PoleWidth2: Integer;
  l, t: Integer;
  CharHeight: Integer;
  s, NewS, TextSpace: string;
begin
  i := 1;
  s := '';

  TextSpace := Text + ' ';              // Пробел в коне для правильной работы
                                        // цикла while

  CharHeight := Canvas.TextHeight('V'); // Высота символов

  oldWidth := 0;

  PoleWidth := Rect.Left + Rect.Right;  // Длина всего поля для рисования
  PoleWidth2 := PoleWidth div 2;        // Половина длины поля
  t := Rect.Top;                        // Высота, на которой выводится строка

  while PosEx(' ', TextSpace, i) <> 0 do
  begin
    NewS := Copy(TextSpace, i, PosEx(' ', TextSpace, i) - i + 1);

    Width := Canvas.TextWidth(NewS);
    if Width + oldWidth < PoleWidth then
    begin
      s := s + NewS;
      Inc(oldWidth, Width);
    end
    else
    begin
      if oldWidth > 0 then
      begin
        // Рисование буфера и очистка его
        l := PoleWidth2 - oldWidth div 2 + Rect.Left;
        Canvas.TextOut(l, t, s);
        s := NewS;
        oldWidth := Width;
      end
      else
      begin
        // Рисуем одно слово
        oldWidth := 0;
        s := '';

        l := PoleWidth2 - Width div 2 + Rect.Left;
        Canvas.TextOut(l, t, NewS);
      end;

      Inc(t, CharHeight);
      if t + CharHeight > Rect.Bottom then
      begin
        oldWidth := 0;
        Break;
      end;
    end;

    // Следующее слово
    i := PosEx(' ', TextSpace, i) + 1;
  end;

  // Вывод остатков текста
  if oldWidth > 0 then
  begin
    l := PoleWidth2 - oldWidth div 2 + Rect.Left;
    Canvas.TextOut(l, t, s);
  end;
end;

[Zanooda]

procedure DrawTextRectEx(Text: AnsiString; var R: TRect; const Canvas: TCanvas;
  CalcRect: Boolean);
var
  Stri: TStringList;
  i, j, x, y, H, W: Integer;
  s: String;
begin
  Stri := TStringList.Create;
  try
    y := R.Top;
    x := R.Left;
    H := Canvas.TextHeight('H');
    W := Canvas.TextWidth('W');
    Stri.Text := String(Text);
    for i := 0 to Stri.Count - 1 do
    begin
      s := Stri.Strings[i];
      x := R.Left;
      H := Canvas.TextHeight(s);
      for j := 1 to Length(s) do
      begin
        if not CalcRect then
          Canvas.TextOut(x, y, s[j]);
        W := Canvas.TextWidth(s[j]);
        Inc(x, W);
        if x > R.Right then
        begin
          x := R.Left;
          Inc(y, H);
          if not CalcRect then
          begin
            if y > R.Bottom then
            begin
              Break;
            end;
          end;
        end;
      end;
      if not CalcRect then
      begin
        if y > R.Bottom then
        begin
          Break;
        end;
      end;
    end;
    if x + W > R.Right then
      R.Right := x + W;
    if y + H > R.Bottom then
      R.Bottom := y + H;
  finally
    Stri.Free;
  end;
end;