procedure TForm1.RTFPaint(dstCanvas: TCanvas; rtfEdit: TRichEdit);
const
  rtfOffsetC = 2; // TRichEdit renders text at 2 pixel offset
  twipsC = 1440; // 1440 TWIPS = 1 inch.
var
  fr     : TFormatRange;
  lpx, lpy: integer;
  sx, sy : double;
  dc     : HDC;
  w, h   : integer;
begin
  dc := GetDC(rtfEdit.Handle);
  var
    cxPhys: integer := GetDeviceCaps(dc, PHYSICALWIDTH);
  var
    cyPhys: integer := GetDeviceCaps(dc, PHYSICALHEIGHT);
  if cxPhys = 0 then
    cxPhys := 190;
  if cyPhys = 0 then
    cyPhys := 80;

  //  SendMessage(rtfEdit.handle, EM_SETTARGETDEVICE, WPARAM(dstCanvas.Handle), cxPhys);
  lpx := GetDeviceCaps(dstCanvas.Handle, LOGPIXELSX);
  if lpx = 0 then
    lpx := 96;
  lpy := GetDeviceCaps(dstCanvas.Handle, LOGPIXELSY);
  if lpy = 0 then
    lpy := 96;
  sx := twipsC / lpx;
  sy := twipsC / lpy;

  FillChar(fr, SizeOf(fr), 0);

  fr.hdc := dstCanvas.Handle;
  fr.hdcTarget := dstCanvas.Handle;
  //define rendering rectangles
  w := round(rtfEdit.ClientWidth * sx);
  h := round(rtfEdit.ClientHeight * sy);

  fr.rc := Rect(0, 0, round(w * sx), round(h * sy));
  InflateRect(fr.rc, -round(rtfOffsetC * sx), 0); //-round(rtfOffsetC*sy));
  fr.rcPage := fr.rc;
  //define to render all text
  fr.chrg.cpMin := 0;
  fr.chrg.cpMax := -1;

  //render the rich text
  SendMessage(rtfEdit.handle, EM_FORMATRANGE, 1, LPARAM(@fr));
  //clear the richtext cache
  SendMessage(rtfEdit.handle, EM_FORMATRANGE, 0, 0);

  ReleaseDC(rtfEdit.Handle, dc);
end;

procedure TForm1.SaveToMetafile();
var
  shapeSize, rtfSize: TSize;
  dc               : HDC;
  h                : Integer;

  mf : TMetafile;
  mfc: TMetafileCanvas;
  r : Cardinal;
  w : Integer;
begin
  FCodeVersion := cbxCode.ItemIndex;

  shapeSize.cx := rtfCtrl.Width;
  shapeSize.cy := rtfCtrl.Height;
  dc := HDC(0);
  mf := TMetafile.Create;
  try
    w := shapeSize.cx;
    h := shapeSize.cy;
    mf.Enhanced := True;
    if FCodeVersion = 3 then begin
      w := Muldiv(w, 100, 175); // gilt nur bei 175% skalierung
      h := Muldiv(h, 100, 175);
    end;

    mf.SetSize(w, h);

    mfc := TMetafileCanvas.Create(mf, 0);

    try
      RTFPaint(mfc, rtfCtrl);

      mfc.MoveTo(0, 0);
      mfc.LineTo(shapeSize.cx, shapeSize.cy);
      mfc.MoveTo(shapeSize.cx, 0);
      mfc.LineTo(0, shapeSize.cy);

    finally
      mfc.Free;
    end;
    mf.SaveToFile(Format('.\MetaFile_RTF_%d.emf', [FCodeVersion]));
    StatusBar1.Panels[1].Text := Format('MF wxh = %d x%d (%d x%d [mm])', [mf.Width, mf.Height, mf.MMWidth, mf.MMHeight]);
  finally
    mf.Free;
    if dc <> HDC(0) then
      ReleaseDC(rtfCtrl.Handle, dc);
  end;

end;

procedure TForm1.Grid2Metafile();
var
  h, w        : integer;
  mfc         : TMetafileCanvas;
  clipRgn     : HRGN;
  shapeSize   : TSize;
begin
  //-- delete an already existing metafile
  if Assigned(FMetaFile) then
    FMetaFile.Free();

  shapeSize.cx := grdData.Width;
  shapeSize.cy := grdData.Height;


  FMetaFile := TMetafile.Create();
  try
    w := shapeSize.cx;
    h := shapeSize.cy;
    FMetaFile.Enhanced := True;
    if FCodeVersion = 3 then begin
      w := Muldiv(w, 100, 175);
      h := Muldiv(h, 100, 175);
    end;

    with grdData do begin
      ScrollBars := ssNone;
      PrintSettings.Title := ppNone;        // ppTopCenter; //ppNone; // NO title
      PrintSettings.TitleText := '<unused>'; // NO title // do not localize
      PrintSettings.NoAutoSize := true;
      PrintSettings.NoAutoSizeRow := true;
      PrintSettings.FitToPage := fpNever; // TFitToPage = (fpNever,fpGrow,fpShrink,fpAlways,fpCustom);
      PrintSettings.Centered := false;
      PrintSettings.RepeatFixedRows := true;
      PrintSettings.PrintGraphics := true; // NO title
      ShowSelection := false;
    end;


    FMetaFile.SetSize(w, h);
    mfc := TMetafileCanvas.CreateWithComment(FMetaFile, HDC(0), ClassName, 'PrepareMetafile');
    try
      //now let TMS do the painting
      self.PaintTo(mfc, 0, 0);

    finally
      DeleteObject(clipRgn);
      FreeAndNil(mfc);
    end;
    FMetaFile.SaveToFile(Format('.\MetaFile_Grid_%d.emf', [FCodeVersion]));

  except
    FreeAndNil(FMetaFile);
  end;

end;