1

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.

Martin
  • 1,065
  • 1
  • 17
  • 36

2 Answers2

6

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:

enter image description here

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;

enter image description here

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:

enter image description here

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:

enter image description here

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

David Heffernan
  • 601,492
  • 42
  • 1,072
  • 1,490
  • It's true that GR32_Text is simple to use, and supports unicode even on older Delphi versions. But it will not handle R2L (right-to-left) scripts correctly, since it seems to paint every character individually. In shape changing scripts and hebrew that won't work. Arab may look like arab still, but it will be meaningless. An extension to GR32 which supports arab scripts would be much welcomed. – MyICQ Oct 25 '20 at 07:20
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:

Screenshot

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

NGLN
  • 43,011
  • 8
  • 105
  • 200