Вывод многострочного текста под углом

← →
Roman_ (2001-11-16 23:00) [0]

Привет, ребята! Малость зашиваюсь со сроками поэтому рещил провопить SOS :)

Дело вот в чем: нужно создать инструмент наподобие Artistic Text в Corel Draw. То есть нужно описать вывод многострочного текста под углом, с возможностью выравнивания его по любому краю, поддержкой стилей и интервалов между символами.
Интервалы и стили хрен с ними. Как выводить несколько строк текста под любым углом?

И еще, никто не видел алгоритмов по выводу тексту вокруг круга?

Спасибо, если кто поможет.

← →
Nikolay (2001-11-17 17:00) [1]

посмотри, не уверен, что это то что нужно...

function CreateRotatedFont(F : TFont; Angle : Integer) : hFont; {-create a rotated font based on the font object F} var LF : TLogFont; begin FillChar(LF, SizeOf(LF), #0); with LF do begin lfHeight := F.Height; lfWidth := 0; lfEscapement := Angle * 10; lfOrientation := 0; if fsBold in F.Style then lfWeight := FW_BOLD else lfWeight := FW_NORMAL; lfItalic := Byte(fsItalic in F.Style); lfUnderline := Byte(fsUnderline in F.Style); lfStrikeOut := Byte(fsStrikeOut in F.Style); lfCharSet := DEFAULT_CHARSET; StrPCopy(lfFaceName, F.Name); lfQuality := DEFAULT_QUALITY; {everything else as default} lfOutPrecision := OUT_DEFAULT_PRECIS; lfClipPrecision := CLIP_DEFAULT_PRECIS; case F.Pitch of fpVariable : lfPitchAndFamily := VARIABLE_PITCH; fpFixed : lfPitchAndFamily := FIXED_PITCH; else lfPitchAndFamily := DEFAULT_PITCH; end; end; Result := CreateFontIndirect(LF); end; ... {create the rotated font} if FontAngle <> 0 then Canvas.Font.Handle := CreateRotatedFont(Font,FontAngle); ...

Вращаются только векторные шрифты.

Вот так!

← →
Roman_ (2001-11-18 01:05) [2]

Идея, конечно интересная.
Я попробовал и вот что обнаружил:
1. не выводится текст под углом если lfCharSet := DEFAULT_CHARSET; зато ANSI_CHARSET работаеот ОК
2. не пашет если lfFaceName оставить прежним.

исходничек почти тот который нужно, спасибо за него. Вопрос в том чем выводить текст?? TextOut не понимает перевод строки, DrawText обрезает текст, если он выхдит за границы области

← →
Nikolay (2001-11-18 16:45) [3]

Сознаюсь, исходник не мой, но автора не указал потому что не помню кто :-(
а жаль........

Насчет текста, попробуй определять длину нужную для выводы текста,
и задавай ее для границ.....

Вот так!

← →
Roman_ (2001-11-19 00:04) [4]

Проблема решилась. Вопрос теперь такой: а как выводить текст по кругу???
Кидаю то что я написал. Немного криво вышло, в том то и проблема. Может кто то, что то посоветует?

const
mx: Integer = -10; //отступ от края канвы
my: Integer = -10; //отступ от края канвы
sangle: Integer = 0; //начальный угол
eangle: Integer = 360; //конечный угол
drawing_text: String = "This is the TEST"; //текст

procedure TForm1.PBoxPaint(Sender: TObject);
//возвращает ширину (высоту) прямоугольника деленную на два
function RectDiv2(ARect: TRect; AHeight: Boolean): Integer;
begin
if AHeight then Result:= (ARect.Bottom - ARect.Top) div 2 else
Result:= (ARect.Right - ARect.Left) div 2;
end;
var
px, py, i, a: Integer;
oldf: TFont;
logf: TLogFont;
ts: TSize;
s: String;
begin
with PBox.Canvas do
begin
//чистим канву
Brush.Color:= clWhite;
Pen.Color:= clBlack;
Pen.Width:= 1;
Rectangle(ClipRect);
r:= ClipRect;
//круг вокру которого выводим текст
InflateRect(r, mx, my);
Ellipse(r);
//font routin
//переназначаем шрифтыи иполучаем LogFont канвы
oldf:= TFont.Create;
oldf.Assign(Font);
Font.Size:= 12;
GetObject(Font.Handle, sizeof(TLogFont), @logf);
//drawing routin
s:= drawing_text + " "; //пробел в конце (для углов 1:0; 2:360;)
//угол смещения
a:= (eangle - sangle) div (Length(s) - 1);
for i:= 0 to Length(s) -1 do
begin
//координата Х буквы
px:= Trunc(-RectDiv2(r, false)*cos((sangle + a*i)*Pi/180) + (RectDiv2(r, false) + abs(mx)));
//координата У буквы
py:= Trunc(-RectDiv2(r, true)*sin((sangle + a*i)*Pi/180) + (RectDiv2(r, true) + abs(my)));
//поворот буквы: 90 градусов минус угол смещения
logf.lfEscapement:= (90 - (sangle + a*i))*10;
logf.lfPitchAndFamily:= DEFAULT_PITCH or FF_DONTCARE;
logf.lfQuality:= PROOF_QUALITY;
//просьба не ставить MS Sans Serif, не будет работать
logf.lfFaceName:= "Times New Roman";
//создаем временный фонт и назначаем его текущему на канве
Font.Handle:= CreateFontIndirect(logf);
SetBkMode(Handle, TRANSPARENT);
//получаем высоту, ширину буквы выведеной новым шрифтом
// и обновляем координаты
ts:= TextExtent(s[i + 1]);
if px < (RectDiv2(r, false) + abs(mx)) then Dec(px, ts.cx div 2) else Inc(px, ts.cx div 2);
if py < (RectDiv2(r, true) + abs(my)) then Dec(py, ts.cy div 2) else Inc(py, ts.cy div 2);
//выводим букву
TextOut(px, py, s[i + 1]);
end;
Font.Assign(oldf);
oldf.Free;
end;
end;

Вывод многострочного текста под углом Найти похожие ветки