Как выдать текст под наклоном?
Материал из DRKB
Как выдать текст под наклоном?[править | править код]
Чтобы вывести под любым углом текст необходимо использовать TrueType Fonts (например "Arial"). Например:
var
LogFont: TLogFont;
GetObject(Canvas.Font.Handle, SizeOf(TLogFont), @LogFont);
{ Вывести текст 1/10 градуса против часовой стрелки }
LogFont.lfEscapement := Angle*10;
Canvas.Font.Handle := CreateFontIndirect(LogFont);
ID: 01937
{ Эта процедура устанавливает угол вывода текста для указанного 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;
ID: 01938
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;
ID: 01939
Пример демонстрирует вывод теста случайным образом на форме под определённым углом. Добавляем в форму компонент 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: 01940
{ 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: 01941