Как вывести текст, написанный под углом или вращение текста
Материал из DRKB
Используя 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