procedure TextOutAngle(const Canvas: TCanvas; X, Y: Integer; const AText: String; AAngle: Integer);
var
 hCurFont: HFONT;
 LogFont: TLogFont;
begin

 with Canvas do
 begin
 
 hCurFont := Font.Handle;
  try
  
   GetObject(Font.Handle, SizeOf(LogFont), @LogFont);
   LogFont.lfEscapement := AAngle;
   LogFont.lfOrientation := AAngle;

   Font.Handle := CreateFontIndirect(LogFont);
   try
    TextOut(X, Y, AText);
   finally
    DeleteObject(Font.Handle);
   end;
  finally
   Font.Handle := hCurFont;
  end;
 end;

end;