Форум: "WinAPI";
Поиск по всему сайту: delphimaster.net;
Текущий архив: 2002.01.17;
Скачать: [xml.tar.bz2];




Вниз

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


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;




Форум: "WinAPI";
Поиск по всему сайту: delphimaster.net;
Текущий архив: 2002.01.17;
Скачать: [xml.tar.bz2];




Наверх





Память: 0.73 MB
Время: 0.018 c
3-52513           vangog                2001-12-17 10:55  2002.01.17  
порядковый номер строки в DBGrid


3-52456           ЧП                    2001-12-13 15:32  2002.01.17  
Мужики у кого есть FR_class.pas для FastReport 2.45 под Delphi 6


3-52460           ol                    2001-12-14 10:33  2002.01.17  
SQL: вложенный запрос под MSSQL


1-52566           greenrul              2001-12-28 17:23  2002.01.17  
Первый раз столкнулся с DLL - plz HELP!!!


14-52659          lel                   2001-11-20 14:24  2002.01.17  
Всем у кого траффик халявный качайте, посмейтесь