Drawing text with angle

[Kambiz]

The following function writes a string on the canvas with the specified angle.

Code: Select all

procedure DrawAngledText(Canvas: TCanvas; X, Y: Integer;
  const Angle: Double; Alignment: Integer; const Text: String);
var
  LogFont: TLogFont;
  FontHandle: THandle;
  TextAlign: Integer;
begin
  GetObject(Canvas.Font.Handle, SizeOf(LogFont), @LogFont);
  LogFont.lfEscapement := Round(Angle * 10);
  LogFont.lfOrientation := LogFont.lfEscapement;
  LogFont.lfQuality := PROOF_QUALITY;
  FontHandle := SelectObject(Canvas.Handle, CreateFontIndirect(LogFont));
  TextAlign := SetTextAlign(Canvas.Handle, Alignment);
  Canvas.TextOut(X, Y, Text);
  SetTextAlign(Canvas.Handle, TextAlign);
  DeleteObject(SelectObject(Canvas.Handle, FontHandle));
end;

The Angle parameter is in degrees and the Alignment parameter specifies the text alignment by using a mask of the values in the following list. Only one flag can be chosen from those that affect horizontal and vertical alignment.

TA_BASELINE
The reference point will be on the base line of the text.

TA_BOTTOM
The reference point will be on the bottom edge of the bounding rectangle.

TA_TOP
The reference point will be on the top edge of the bounding rectangle.

TA_CENTER
The reference point will be aligned horizontally with the center of the bounding rectangle.

TA_LEFT
The reference point will be on the left edge of the bounding rectangle.

TA_RIGHT
The reference point will be on the right edge of the bounding rectangle.

Here is also an example of usage:

Code: Select all

procedure TForm1.FormPaint(Sender: TObject);
begin
  DrawAngledText(Canvas, ClientWidth div 2, ClientHeight div 2,
  45, TA_BOTTOM or TA_CENTER, 'Powered by Borland Delphi.');
end;

By the way, the canvas' font should be a TrueType font.

Cheers,
Kambiz

[array81]

Hi,

is there a way to know the bounding rectangle of the rotated text?
I need (if possible without draw the text) know the 4 corners of the rectangle (rotated) that contains the text.

Do you know a way?

regards

[Kambiz]

Yes, there is. First find the bounding rectangle of text without rotation, then rotate the four vertex points of the rectangle.

Here is the code for rotating points:

Code: Select all

procedure RotatePoints(var Points: array of TPoint;
  Angle: Double; const OrgPt: TPoint);
var
  Sin, Cos: Extended;
  Prime: TPoint;
  I: Integer;
begin
  while Angle > Pi do Angle := Angle - 2 * Pi;
  while Angle < -Pi do Angle := Angle + 2 * Pi;
 SinCos(Angle, Sin, Cos);
 for I := Low(Points) to High(Points) do
   with Points[I] do
   begin
     Prime.X := X - OrgPt.X;
     Prime.Y := Y - OrgPt.Y;
     X := Round(Prime.X * Cos - Prime.Y * Sin) + OrgPt.X;
     Y := Round(Prime.X * Sin + Prime.Y * Cos) + OrgPt.Y;
   end;
end;