Расчет размера текста перед рисованием на холсте - PullRequest
Новая
       36

Расчет размера текста перед рисованием на холсте

9 голосов
/ 11 октября 2011

Я использую Delphi 7. Я более чем знаком с использованием холста и рисованием текста на холсте, а также с использованием TCanvas.TextHeight и т. Д. Проблема возникает, когда я хочу реализовать Word Wrap.Мне нужен не только лучший способ отрисовки текста на холсте и его автоматического переноса с заданным ограничением ширины, но также мне нужно знать, как высоко (или сколько строк) он будет после обтекания.Мне нужно подготовить другое изображение перед тем, как я начну рисовать текст, изображение, которое должно быть достаточно большим, чтобы разместить обернутый текст.Это попытка воспроизвести то, как iPhone отображает SMS-сообщения, с шариком по обе стороны экрана в поле прокрутки с переменной высотой (моя основа - TScrollingWinControl).

1 Ответ

35 голосов
/ 11 октября 2011

Используйте (почти) всемогущую функцию 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 (или уменьшил ширину r если 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

...