Форум программистов
 
Регистрация на форуме тут, о проблемах пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail, а тут можно восстановить пароль

Купить рекламу на форуме 15-35 тыс рублей в месяц

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Ответ
 
Опции темы Поиск в этой теме
Старый 06.01.2013, 19:07   #1
Puhovoi
Пользователь
 
Аватар для Puhovoi
 
Регистрация: 16.10.2010
Сообщений: 47
По умолчанию Рисование многострочного текста BitMap

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

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

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

Заранее спасибо за ответы.
Puhovoi вне форума Ответить с цитированием
Старый 06.01.2013, 20:13   #2
kangreon
Форумчанин
 
Аватар для kangreon
 
Регистрация: 03.04.2009
Сообщений: 305
По умолчанию

В 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 (рус)

Последний раз редактировалось kangreon; 06.01.2013 в 20:20.
kangreon вне форума Ответить с цитированием
Старый 07.01.2013, 15:51   #3
Puhovoi
Пользователь
 
Аватар для Puhovoi
 
Регистрация: 16.10.2010
Сообщений: 47
По умолчанию

Благодарю, воспользовался DrawText. Но батюшки, как же она тормозит (рисование на канве десяти строк текста - 200 мс. в среднем).
Puhovoi вне форума Ответить с цитированием
Старый 08.01.2013, 00:24   #4
kangreon
Форумчанин
 
Аватар для kangreon
 
Регистрация: 03.04.2009
Сообщений: 305
По умолчанию

Странно, что тормозит. Я тут набросал процедуру, выводящую текст в рамку с выравниванием по центру. Рисует текст на форме, в событии 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;
kangreon вне форума Ответить с цитированием
Старый 03.12.2021, 13:02   #5
Zanooda
 
Регистрация: 20.01.2010
Сообщений: 9
По умолчанию

Код:

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;
Zanooda вне форума Ответить с цитированием
Ответ
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
рисование на Bitmap с PixelFormat.Format1bppIndexed jetyb Общие вопросы .NET 0 15.11.2012 11:34
В Билдере есть какой-нибудь компонент для многострочного вывода текста, аналогично Edit? Наталия 555 C++ Builder 4 15.06.2011 13:12
32bpp bitmap вывод текста через GDI+ Celestia Мультимедиа в Delphi 1 30.11.2010 19:07
Рисование выделяемого текста tigrantairov Win Api 0 01.03.2010 22:54
из-за чего появляется полоса (на скрине) при вставке BitMap в TImage? - Проблема с Bitmap Grey@2009 Мультимедиа в Delphi 2 02.01.2010 20:23