function CreateAngledFont(oFont : TFont; Angle : integer): HFont;
// передаю другой oFont, чтобы с параметрами не гемороиться
// а просто списать с уже существующего
var
  LogFont : TLogFont;
begin
  with LogFont do
  try
    lfHeight := oFont.Height;
    lfWidth :=  0 ; { have font mapper choose }
    lfEscapement := Angle; { only straight fonts }
    lfOrientation := Angle; { no rotation }
    if fsBold in oFont.Style then
      lfWeight := FW_BOLD
    else
      lfWeight := FW_NORMAL;
    lfItalic := Byte(fsItalic in oFont.Style);
    lfUnderline := Byte(fsUnderline in oFont.Style);
    lfStrikeOut := Byte(fsStrikeOut in oFont.Style);
    lfCharSet := Byte(oFont.Charset);
    if AnsiCompareText(oFont.Name, 'Default') =  0  then  // do not localize
      StrPCopy(lfFaceName, DefFontData.Name)
    else
      StrPCopy(lfFaceName, oFont.Name);
    lfQuality := DEFAULT_QUALITY;
    { Everything else as default }
    lfOutPrecision := OUT_DEFAULT_PRECIS;
    lfClipPrecision := CLIP_DEFAULT_PRECIS;
    case oFont.Pitch of
      fpVariable: lfPitchAndFamily := VARIABLE_PITCH;
      fpFixed: lfPitchAndFamily := FIXED_PITCH;
    else
      lfPitchAndFamily := DEFAULT_PITCH;
    end;
  finally
  end;
  Result := CreateFontIndirect(LogFont);
end;

...
var nFont, oFont : HFont;
...
Canvas.Font.Name := 'Times New Roman';
nFont := CreateAngledFont(Canvas.Font,  900 );
oFont := Canvas.Font.Handle
Canvas.Font.Handle := nFont;
...
Canvas.TextOut(ТудыX, СюдыY, 'Трям!');
...
Canvas.Font.Handle := oFont;
DeleteObject(nFont);