[GriLab]

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

1. Каким образом можно нарисовать (вывести) текст на Canvas с переносом строки, т.е. определенной ширины (подобно WordWrap в Label), и узнать его высоту в пикселах?

2. Как вывести текст на Canvas, исходя из HTML-кода, т.е. применяя теги: <b>, <font>, <i>, <quote> и т.д.?

3. Совместить 1-ый и 2-ой пункты???

Если можно исходники киньте, или помогите разобраться. Заранее спасибо!

[ryderx34]

Код:

var
  S: String;
  R: TRect;
  H: Integer;

H := DrawText(Canvas.Handle, PChar(S), Length(S), R, DT_WORDBREAK or DT_NOCLIP);
ShowMessage('Высота текста = ' + IntToStr(H));

[NumLock]

1.

Код:

type
  TForm1 = class(TForm)
    procedure FormPaint(Sender: TObject);

procedure TForm1.FormPaint(Sender: TObject);
var
  s: String;
  rct: TRect;
  w, h: Integer;
begin
  w:=100; // исходная ширина прямоугольника с текстом
  h:=0; // высота не нужна пока
  s:='Каким образом можно нарисовать (вывести) текст на Canvas с переносом строки, т.е. определенной ширины (подобно WordWrap в Label), и узнать его высоту в пикселах?';
  rct.Left:=100; // коорд. X для вывода прямоугольника с текстом
  rct.Top:=100; // коорд. Y для вывода прямоугольника с текстом
  rct.Right:=rct.Left+w;
  rct.Bottom:=rct.Top+h;
  // вычислим размеры прямоугольника
  DrawText(Canvas.Handle, PChar(s), -1, rct, DT_CALCRECT or DT_WORDBREAK);
  // нарисуем текст
  DrawText(Canvas.Handle, PChar(s), -1, rct, DT_WORDBREAK);
end;

2. парсить текст и применять Canvas.Font.Style:=[fsBold, fsItalic];

3. 1+2

[GriLab]

ryderx34 и NumLock, спасибо очень помогли.

[Janom]

A если все ручками сделать то как-то так получится...

Код:

Function WordWrapTextToCanvas(aCanvas:TCanvas; aText:String; X,Y,RigthBord:Integer; LS:Real):boolean;
var
  i,W,W1,Spc,XX:Integer;
  S:String;
  aT:array of String;
begin
W:=aCanvas.TextWidth(aText);
Spc:=aCanvas.TextWidth(' ');
XX:=X;
W1:=0;
S:='';
aText:=aText+' ';
if W>RigthBord then
  begin
    for i:=1 to Length(aText) do
      begin
        if aText[i]<>' ' then
          S:=S+aText[i]
        else begin
          SetLength(aT,Length(aT)+1);
          aT[Length(aT)-1]:=S;
          S:='';
        end;
      end;
    for i:=0 to Length(aT)-1 do
      begin
        W1:=W1+aCanvas.TextWidth(aT[i]);
        if W1>RigthBord then
          begin
            Y:=Round(Y+(aCanvas.TextHeight(aT[i])*LS));
            X:=XX;
            W1:=0;
          end;
        aCanvas.textOut(X,Y,aT[i]);
        X:=X+Spc+aCanvas.TextWidth(aT[i]);
      end;
    Result:=true;
  end else aCanvas.TextWidth(aText);
end;

Использовать так:

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  S: String;
  X,Y,L: Integer;
begin
Image1.Width:=583;
Image1.Canvas.Font.Size:=14;
X:=20;
L:=Image1.Width-60;
Y:=20;
S:='Это очень длинная строка, возможно самая длинная, которую когда либо писали в Delphi';

WordWrapTextToCanvas(Image1.Canvas,S,X,Y,L,1.1); //Отрисовка текста
end;

Параметры:
aCanvas = Канва на которую выносим текст
aText = Текст
X = Отступ от левой границы канвы
Y = Отступ от верхней границы канвы
RigthBord = Отступ от правой границы канвы
LS = Межстрочный интервал

[GriLab]

Спасибо. Тема закрыта.