Как выдать текст под наклоном?

Материал из 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