Draw rotate multiline text with GDI and GDI+

Question

On my Delphi application I need draw a multiline text with GDI and GDI+. I have these items:

1. Text to draw;
2. Rotate angle (the text may be rotate);
3. Max width (imagine the rectangle that contains the text, I have a limit for rectangle width but not for rectangle height);
4. Font name and text height;

Is there a easy way to draw this text both with GDI and GDI+? I cannot found GDI and GDI+ functions about it.

Answer 1

tl; dr

Use graphics32 with GR32_Text.

---

For GDI, the simplest way is to use the escapement and orientation properties of the font. For instance:

procedure TForm1.PaintBox1Paint(Sender: TObject);
const
  Text = 'Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do '
    + 'eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim '
    + 'ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut '
    + 'aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit '
    + 'in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur '
    + 'sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt '
    + 'mollit anim id est laborum.';
var
  angle: Integer;
  Canvas: TCanvas;
  lf: LOGFONT;
  R: TRect;
begin
  Canvas := PaintBox1.Canvas;

  Canvas.Brush.Style := bsClear; // Set the brush style to transparent.
  lf := Default(LOGFONT);
  lf.lfHeight := 20;
  lf.lfCharSet := DEFAULT_CHARSET;
  lf.lfFaceName := 'Times New Roman';

  angle := 15;
  lf.lfEscapement := 10*angle;//lfEscapement measured in 1/10th of degree
  lf.lfOrientation := lf.lfEscapement;
  Canvas.Font.Handle := CreateFontIndirect(lf);
  R := PaintBox1.ClientRect;
  inc(R.Top, 200);
  DrawText(Canvas.Handle, Text, -1, R, DT_NOCLIP or DT_WORDBREAK);
end;

which produces the rather strangely laid out:

Using SetWorldTransform gives a different layout, although still rather poor quality:

procedure TForm1.PaintBox1Paint(Sender: TObject);
const
  Text = 'Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do '
    + 'eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim '
    + 'ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut '
    + 'aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit '
    + 'in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur '
    + 'sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt '
    + 'mollit anim id est laborum.';
var
  angle: Integer;
  Transform: TXForm;
  Canvas: TCanvas;
  lf: LOGFONT;
  R: TRect;
begin
  Canvas := PaintBox1.Canvas;

  angle := 15;
  Transform := Default(TXForm);
  SinCos(DegToRad(-angle), Transform.eM12, Transform.eM11);
  Transform.eM22 := Transform.eM11;
  Transform.eM21 := -Transform.eM12;

  SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
  SetWorldTransform(Canvas.Handle, Transform);

  Canvas.Brush.Style := bsClear; // Set the brush style to transparent.
  lf := Default(LOGFONT);
  lf.lfHeight := 20;
  lf.lfCharSet := DEFAULT_CHARSET;
  lf.lfFaceName := 'Times New Roman';
  Canvas.Font.Handle := CreateFontIndirect(lf);
  R := PaintBox1.ClientRect;
  inc(R.Top, 200);
  inc(R.Left, Round(200*Transform.eM12));
  DrawText(Canvas.Handle, Text, -1, R, DT_NOCLIP or DT_WORDBREAK);
end;

Frankly, I think you are not going to get good results using either of these approaches. If I were you I would use a good library such as graphics32 with Angus Johnson's GR32_Text:

---

For GDI+, the results are much the same as for GDI. Sample code would be:

uses
  GDIPAPI, GDIPOBJ;

....

{$TYPEDADDRESS ON}
procedure TForm1.PaintBox1Paint(Sender: TObject);
const
  Text = 'Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do '
    + 'eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim '
    + 'ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut '
    + 'aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit '
    + 'in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur '
    + 'sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt '
    + 'mollit anim id est laborum.';
var
  Graphics: TGPGraphics;
  Font: TGPFont;
  Brush: TGPBrush;
  lf: LOGFONT;
begin
  Graphics := TGPGraphics.Create(PaintBox1.Canvas.Handle);
  try
    Graphics.SetTextRenderingHint(TextRenderingHintSystemDefault);

    lf := Default(LOGFONT);
    lf.lfHeight := 20;
    lf.lfCharSet := DEFAULT_CHARSET;
    lf.lfFaceName := 'Times New Roman';

    Font := TGPFont.Create(PaintBox1.Canvas.Handle, @lf);
    try
      Brush := TGPSolidBrush.Create(MakeColor(0, 0, 0));
      try
        Graphics.RotateTransform(-15);
        Graphics.DrawString(
          Text,
          -1,
          Font,
          MakeRect(0.0, 150.0, 450.0, 600.0),
          nil,
          Brush
        );
      finally
        Brush.Free;
      end;
    finally
      Font.Free;
    end;
  finally
    Graphics.Free;
  end;
end;

And the output:

Still pretty naff looking in my view. So for best quality, I would recommend graphics32 with GR32_Text.

Answer 2

The basics seem to be simple:

procedure TForm2.FormPaint(Sender: TObject);
const
  S = 'Multiline sample text with 50 degrees rotation';
  H = 20;
  A = -50;
var
  R: TRect;
  NewFont: HFONT;
  OldFont: HFONT;
  TextHeight: Integer;
begin
  R := ClientRect;
  InflateRect(R, -20, -20);
  NewFont := CreateFont(-H, 0, A * 10, A * 10, FW_NORMAL, 0, 0, 0,
    DEFAULT_CHARSET, OUT_TT_ONLY_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
    DEFAULT_PITCH, 'Tahoma');
  try
    OldFont := SelectObject(Canvas.Handle, NewFont);
    DrawText(Canvas.Handle, S, -1, R, DT_LEFT or DT_BOTTOM or
      DT_WORDBREAK or DT_NOCLIP);
  finally
    DeleteObject(SelectObject(Canvas.Handle, OldFont));
  end;
end;

But it is not for multiline text:

What you need to do is not use the rotation at font level, but at canvas level, with SetWorldTransform.