![]() |
|
|
|||||||
| Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
![]() |
|
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
|
|
#1
|
||||
|
||||
|
Доброго времени суток!
1. Каким образом можно нарисовать (вывести) текст на Canvas с переносом строки, т.е. определенной ширины (подобно WordWrap в Label), и узнать его высоту в пикселах? 2. Как вывести текст на Canvas, исходя из HTML-кода, т.е. применяя теги: <b>, <font>, <i>, <quote> и т.д.? 3. Совместить 1-ый и 2-ой пункты??? Если можно исходники киньте, или помогите разобраться. Заранее спасибо! |
|
#2
|
||||
|
||||
|
Код:
var
S: String;
R: TRect;
H: Integer;
H := DrawText(Canvas.Handle, PChar(S), Length(S), R, DT_WORDBREAK or DT_NOCLIP);
ShowMessage('Высота текста = ' + IntToStr(H)); |
|
#3
|
||||
|
||||
|
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 Последний раз редактировалось NumLock, 14.06.2011 в 09:32. |
|
#4
|
|||
|
|||
|
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 = Межстрочный интервал Последний раз редактировалось Janom, 14.06.2011 в 10:54. |
|
#5
|
||||
|
||||
|
Спасибо. Тема закрыта.
|
|
#6
|
||||
|
||||
|
ryderx34 и NumLock, спасибо очень помогли.
|