Print a TRichEdit upside down

Problem/Question/Abstract:

How to print a TRichEdit upside down

Answer:

Below are the 4 base orientations, but TXForm (in windows.pas) gives you the ability to turn the world to any degree. World transformations are interesting in that they raise the prospect of working in code with portrait objects and simply turning the world, rather than turning the objects individually to conform to the world - which I have been doing up until now.

Note: This does not work for Win9x.

{ ... }
type
  TWorldOrientation = (woPortrait, woLandscape, woInversePortrait,
    woInverseLandscape);

function GetWorldOrientation(APageRect: TRect; AOrientation: TWorldOrientation):
  TXForm;
begin
  case AOrientation of
    woPortrait:
      begin
        Result.eM11 := 0;
        Result.eM12 := 0;
        Result.eM21 := 0;
        Result.eM22 := 0;
        Result.eDX := APageRect.Left;
        Result.eDY := APageRect.Top;
      end;
    woLandscape:
      begin
        Result.eM11 := 0;
        Result.eM12 := -1;
        Result.eM21 := 1;
        Result.eM22 := 0;
        Result.eDX := APageRect.Left;
        Result.eDY := APageRect.Bottom;
      end;
    woInversePortrait:
      begin
        Result.eM11 := -1;
        Result.eM12 := 0;
        Result.eM21 := 0;
        Result.eM22 := -1;
        Result.eDX := APageRect.Right;
        Result.eDY := APageRect.Bottom;
      end;
    woInverseLandscape:
      begin
        Result.eM11 := 0;
        Result.eM12 := 1;
        Result.eM21 := -1;
        Result.eM22 := 0;
        Result.eDX := APageRect.Right;
        Result.eDY := APageRect.Top;
      end;
  end;
end;

function PrintText(ACanvas: TCanvas; APageRect, APrintRect: TRect; AText: string;
  ATextFlags:
  Integer; AOrientation: TWorldOrientation): Boolean;
var
  SaveGM: Integer;
  SaveXF: TXForm; // unit Windows.pas
begin
  {save graphics mode}
  SaveGM := Windows.GetGraphicsMode(ACanvas.Handle);
  {can we do it}
  Result := Windows.SetGraphicsMode(aCanvas.Handle, GM_ADVANCED) <> 0;
  if Result then
  begin
    {save transform}
    Windows.GetWorldTransform(ACanvas.Handle, SaveXF);
    // set orientation
    Windows.SetWorldTransform(ACanvas.Handle, GetWorldOrientation(APageRect,
      AOrientation));
    {move text to page}
    Windows.DrawText(ACanvas.Handle, PChar(AText), -1, APrintRect, ATextFlags);
    {restore transform}
    Windows.SetWorldTransform(ACanvas.Handle, SaveXF);
    {restore graphics mode}
    Windows.SetGraphicsMode(aCanvas.Handle, SaveGM);
  end;
end;

function PrintRichText(ACanvas: TCanvas; APageRect, APrintRect: TRect; ARichEdit:
  TRichEdit;
  APixelsPerInchX, APixelsPerInchY: Integer; AOrientation: TWorldOrientation):
    Boolean;
const
  RICH_TWIPS = 1440;
var
  SaveGM: Integer;
  SaveXF: TXForm; {unit Windows.pas}
  FmtRange: TFormatRange; {unit RichEdit.pas}
begin
  {save graphics mode}
  SaveGM := Windows.GetGraphicsMode(ACanvas.Handle);
  {can we do it}
  Result := Windows.SetGraphicsMode(aCanvas.Handle, GM_ADVANCED) <> 0;
  if Result then
  begin
    {save transform}
    Windows.GetWorldTransform(ACanvas.Handle, SaveXF);
    {set orientation}
    Windows.SetWorldTransform(ACanvas.Handle, GetWorldOrientation(APageRect,
      AOrientation));
    {adjust for twips}
    APrintRect.Left := APrintRect.Left * RICH_TWIPS div APixelsPerInchX;
    APrintRect.Top := APrintRect.Top * RICH_TWIPS div APixelsPerInchY;
    APrintRect.Right := APrintRect.Right * RICH_TWIPS div APixelsPerInchX;
    APrintRect.Bottom := APrintRect.Bottom * RICH_TWIPS div APixelsPerInchY;
    {move rich text to page}
    System.FillChar(FmtRange, SizeOf(FmtRange), 0);
    FmtRange.Hdc := ACanvas.Handle;
    FmtRange.HdcTarget := ACanvas.Handle;
    FmtRange.Rc := APrintRect;
    FmtRange.ChrG.CpMin := 0;
    FmtRange.ChrG.CpMax := Length(ARichEdit.Text);
    ARichEdit.Perform(EM_FORMATRANGE, 1, LongInt(@FmtRange));
    ARichEdit.Perform(EM_FORMATRANGE, 0, 0);
    {restore transform}
    Windows.SetWorldTransform(ACanvas.Handle, SaveXF);
    {restore graphics mode}
    Windows.SetGraphicsMode(aCanvas.Handle, SaveGM);
  end;
end;

Examples:

procedure TForm1.FormCreate(Sender: TObject);
begin
  {Apparently you need to initialise before using the first time otherwise the
        canvas doesn't appear to paint properly}
  Windows.SetGraphicsMode(Self.Canvas.Handle, GM_ADVANCED);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  R: TRect;
begin
  R := Rect(20, 20, 200, 200);
  PrintText(Self.Canvas, Self.ClientRect, R, 'I am portrait', 0, woPortrait);
  PrintText(Self.Canvas, Self.ClientRect, R, 'I am landscape', 0, woLandscape);
  PrintText(Self.Canvas, Self.ClientRect, R, 'We are inverse portrait' + #13#10 +
    'As are we', 0, woInversePortrait);
  PrintText(Self.Canvas, Self.ClientRect, R, 'We are inverse landscape.' + #13#10 +
    'Us to', DT_RIGHT, woInverseLandscape);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  R: TRect;
begin
  if OpenDialog1.Execute then
  begin
    RichEdit1.Lines.LoadFromFile(OPenDialog1.FileName);
    R := Rect(10, 10, 200, 300);
    PrintRichText(Self.Canvas, Self.ClientRect, R, RichEdit1, Screen.PixelsPerInch,
      Screen.PixelsPerInch, woPortrait);
    PrintRichText(Self.Canvas, Self.ClientRect, R, RichEdit1, Screen.PixelsPerInch,
      Screen.PixelsPerInch, woLandscape);
    PrintRichText(Self.Canvas, Self.ClientRect, R, RichEdit1, Screen.PixelsPerInch,
      Screen.PixelsPerInch, woInverseLandscape);
    PrintRichText(Self.Canvas, Self.ClientRect, R, RichEdit1, Screen.PixelsPerInch,
      Screen.PixelsPerInch, woInversePortrait);
  end;
end;