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

== Используя TLogFont ==
Для того чтобы вывести текст под углом, вытянуть или сжать его нужно воспользоваться структурой LOGFONT. Здесь показаны не все ее возможности, но, на мой взгляд, самые интересные.
procedure TForm1.FormPaint(Sender: TObject);
var
 lf: TLogFont;
begin
 FillChar(lf, SizeOf(lf), 0);
 with lf do
 begin
 lfHeight := 15; // Высота буквы
 lfWidth := 20; // Ширина буквы
 lfEscapement := 100; // Угол наклона в десятых градуса
 lfWeight := 1000; // Жирность 0..1000, 0 - по умолчанию
 lfItalic := 0; // Курсив
 lfUnderline := 1; // Подчеркнут
 lfStrikeOut := 1; // Зачеркнут
 lfCharSet := RUSSIAN_CharSet; // CharSet
 StrCopy(lfFaceName, 'Arial'); // Название шрифта
 end;
 with Form1.Canvas do
 begin
 FillRect(ClipRect);
 Font.Handle := CreateFontIndirect(lf);
 TextOut(0, 100, 'It is a text string');
 end;
end;
Author: Pegas
Source: http://forum.vingrad.ru
ID: 03637
----
{ Эта процедура устанавливает угол вывода текста для указанного Canvas, угол в градусах }
{ Шрифт должен быть TrueType ! }
procedure CanvasSetTextAngle(c: TCanvas; d: single);
var
 LogRec: TLOGFONT; { Информация о шрифте }
begin
 { Читаем текущую инф. о шрифте }
 GetObject(c.Font.Handle, SizeOf(LogRec), Addr(LogRec));
 { Изменяем угол }
 LogRec.lfEscapement := Round(d * 10);
 { Устанавливаем новые параметры }
 c.Font.Handle := CreateFontIndirect(LogRec);
end;
Author: Зайцев О.В.
Author: Владимиров А.М.
Source: http://forum.sources.ru
ID: 03638
----
Попробуйте это:
procedure TForm1.TextUp(ARect: TRect; ATxt: string);
var
 LFont: TLogFont;
 hOldFont, hNewFont: HFont;
begin
 GetObject(Canvas.Font.Handle, SizeOf(LFont), Addr(LFont));
 LFont.lfEscapement := 900;
 hNewFont := CreateFontIndirect(LFont);
 hOldFont := SelectObject(Canvas.Handle,hNewFont);
 Canvas.TextOut(aRect.Left+2, ARect.Top, ATxt);
 hNewFont := SelectObject(Canvas.Handle, hOldFont);
 DeleteObject(hNewFont);
end;
Source: http://delphiworld.narod.ru/
ID: 03643
----
== Используя CreateFont ==
procedure TextOutAngle(x, y, AAngle, ASize: Integer; txt: string);
var
 hFont, FontOld: Integer;
 DC: hdc;
 Fontname: string;
begin
 if Length(txt) = 0 then
 Exit;
 DC := Screen.ActiveForm.Canvas.Handle;
 SetBkMode(DC, transparent);
 Fontname := Screen.ActiveForm.Canvas.Font.Name;
 hFont := CreateFont(-ASize, 0, AAngle*10, 0, fw_normal, 0, 0,
 0, 1, 4, $10, 2, 4, PChar(Fontname));
 FontOld := SelectObject(DC, hFont);
 TextOut(DC, x, y, PChar(txt), Length(txt));
 SelectObject(DC, FontOld);
 DeleteObject(hFont);
end;
Source: http://forum.sources.ru
ID: 03639
----
Некоторое время я делал так: я создавал шрифт, выбирал его в DC ...
function CreateMyFont(degree: Integer): HFONT;
begin
 CreateMyFont := CreateFont(
 -30, 0, degree, 0, 0,
 0, 0, 0, 1, OUT_TT_PRECIS,
 0, 0, 0, szFontName);
end;
.... и затем использовал любую функцию рисования для вывода текста.
Source: http://delphiworld.narod.ru/
ID: 03642
----
== С возвратом к прежнему шрифту ==
procedure AngleTextOut(CV: TCanvas; const sText: string; x, y, angle: Integer);
var
 LogFont: TLogFont;
 SaveFont: TFont;
begin
 SaveFont := TFont.Create;
 SaveFont.Assign(CV.Font);
 GetObject(SaveFont.Handle, SizeOf(TLogFont), @LogFont);
 with LogFont do
 begin
 lfEscapement := angle * 10;
 lfPitchAndFamily := FIXED_PITCH or FF_DONTCARE;
 end;
 CV.Font.Handle := CreateFontIndirect(LogFont);
 SetBkMode(CV.Handle, TRANSPARENT);
 CV.TextOut(x, y, sText);
 CV.Font.Assign(SaveFont);
 SaveFont.Free;
end;
Source: http://delphiworld.narod.ru/
ID: 03640
----
== Вертикальный текст на TBitmap ==
procedure TextOutVertical(var bitmap: TBitmap; x, y: Integer; s: string);
var
 b1, b2: TBitmap;
 i, j: Integer;
begin
 with bitmap.Canvas do
 begin
 b1 := TBitmap.Create;
 b1.Canvas.Font := lpYhFont;
 b1.Width := TextWidth(s) + 1;
 b1.Height := TextHeight(s) + 1;
 b1.Canvas.TextOut(1, 1, s);
 b2 := TPackedBitmap.Create;
 b2.Width := TextHeight(s);
 b2.Height := TextWidth(s);
 for i := 0 to b1.Width - 1 do
 for j := 0 to b1.Height do
 b2.Canvas.Pixels[j, b2.Height + 1 - i] := b1.Canvas.Pixels[i, j];
 Draw(x, y, b2);
 b1.Free;
 b2.Free;
 end
end;
Source: http://delphiworld.narod.ru/
ID: 03641
----
== Выводим цветной текст на форме под любым углом ==
Пример демонстрирует вывод теста случайным образом на форме под определённым углом. Добавляем в форму компонент TButton и в событие OnClick следующий код:
procedure TForm1.Button1Click(Sender: TObject);
var
 logfont: TLogFont;
 font: Thandle;
 count: Integer;
begin
 LogFont.lfheight := 20;
 logfont.lfwidth := 20;
 logfont.lfweight := 750;
 LogFont.lfEscapement := -200;
 logfont.lfcharset := 1;
 logfont.lfoutprecision := out_tt_precis;
 logfont.lfquality := draft_quality;
 logfont.lfpitchandfamily := FF_Modern;
 font := CreateFontIndirect(logfont);
 SelectObject(Form1.Canvas.Handle, font);
 SetTextColor(Form1.Canvas.Handle, RGB(0, 0, 200));
 SetBKmode(Form1.Canvas.Handle, transparent);
 for count := 1 to 10 do
 begin
 Canvas.TextOut(Random(Form1.Width), Random(Form1.Height), 'Delphi World');
 SetTextColor(Form1.Canvas.Handle, RGB(Random(255), Random(255), Random(255)));
 end;
 DeleteObject(font);
end;
ID: 03644
----
== Создаем наклонный шрифт на базе существующего ==
{ Create a rotated font based on the font object F }
function CreateRotatedFont(F: TFont; Angle: Integer): hFont;
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);
Вращаются только векторные шрифты.
Source: http://delphiworld.narod.ru/
ID: 03645
Category:Графика
Category:Работа с текстом