scale font when printing richedit XE5 - delphi

Question

I have put a RichEdit on a form to represent part of a page. The size of the 'page' is reduced so that the user can see the whole page to gauge the effect of input. When the 'page' is printed, the RichEdit area is expanded and moved on the printer page to the required position. The code below does this very well with one slight (read MASSIVE) problem. The font does not scale.
I have tried playing around with setting the Window and Viewport origins and extents as the reading I have done seem to point to this. Unfortunately, I have had no success. Could someone please point me in the right direction?
procedure TForm10.PrintNewClick(Sender: TObject);
const
PgHeight=1170;
PgWidth=1170*210 div 294;
var
EdTop,EdLeft,EdWidth,EdHeight :integer;
wPage, hPage, xPPI, yPPI, wTwips, hTwips: integer;
pageRect, rendRect, outline: TRect;
po: TPageOffset;
fr: TFormatRange;
lastOffset, currPage, pageCount: integer;
xOffset, yOffset: integer;
FPageOffsets: array of TPageOffset;
TextLenEx: TGetTextLengthEx;
firstPage: boolean;
PrinterRatioH,PrinterRatioV, ratio:Real;
begin
Printer.Orientation:=poPortrait;
//get printer to 'page' ratios
PrinterRatioH :=Printer.PageWidth/PgWidth;
PrinterRatioV :=Printer.PageHeight/PgHeight;
//get positions and size of richedit on screen 'page'
//top of richedit on screen page
EdTop:=StrToInt(EditTop.Text);
//left of richedit on screen page
if EditCentre.Checked then
EdLeft:=(PgWidth-StrToInt(EditWidth.Text)) div 2
else
EdLeft:=StrToInt(EditLeft.Text);
//Width of richedit on screen page
EdWidth:=StrToInt(EditWidth.Text);
// Height of richedit on screen page
EdHeight:=StrToInt(EditHeight.Text);
//get bounding richedit rectangle on printer
with outline do
begin
left:=Round(EdLeft*PrinterRatioH );
top:=Round(EdTop*PrinterRatioV );
Right:=Left+Round(EdWidth*PrinterRatioH);
Bottom:=Top+Round(EdHeight*PrinterRatioV);
end;
//Get the size of a printed page in printer device units
wPage := GetDeviceCaps(Printer.Handle, PHYSICALWIDTH);
hPage := GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT);
//Next, get the device units per inch for the printer
xPPI := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
if TwipFactor=567 then
xPPI :=round(xPPI / 2.54 ); //change to metric base
yPPI := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
if TwipFactor=567 then
yPPI :=round(yPPI / 2.54 );
//Convert the page size from device units to twips
wTwips := MulDiv(wPage, TwipFactor, xPPI);
hTwips := MulDiv(hPage, TwipFactor, yPPI);
//Save the page size in twips
with pageRect do
begin
Left := 0;
Top := 0;
Right := wTwips;
Bottom := hTwips
end;
//calculate the size and position of the rendering rectangle in twips
with rendRect do
begin
Left :=MulDiv(Outline.Left, TwipFactor, xPPI);
Top := MulDiv(Outline.Top, TwipFactor, yPPI);
Right := MulDiv(Outline.Right, TwipFactor, xPPI);
Bottom := MulDiv(Outline.Bottom, TwipFactor, yPPI);
end;
//set starting offset to zero
po.mStart := 0;
//Define and initialize a TFormatRange structure.
with fr do
begin
hdc := Printer.Handle;
hdcTarget := Printer.Handle;
chrg.cpMin := po.mStart;
chrg.cpMax := -1;
end;
// how much text is in the control.
with TextLenEx do
begin
flags := GTL_DEFAULT;
codepage := CP_ACP;
end;
lastOffset := SendMessage(TestEdit.Handle, EM_GETTEXTLENGTHEX, wParam(#TextLenEx), 0);
//clear the formatting buffer
SendMessage(TestEdit.Handle, EM_FORMATRANGE, 0, 0);
SaveDC(fr.hdc);
SetMapMode(fr.hdc, MM_ANISOTROPIC{MM_TEXT});
SetViewportOrgEx(fr.hdc, 0, 0, nil);
SetViewportExtEx(fr.hdc, TestEdit.Width ,testedit.Height , nil);
//build a table of page entries,
while ((fr.chrg.cpMin <> -1) and (fr.chrg.cpMin < lastOffset)) do
begin
fr.rc := rendRect;
fr.rcPage := pageRect;
po.mStart := fr.chrg.cpMin;
fr.chrg.cpMin := SendMessage(TestEdit.Handle, EM_FORMATRANGE, 0, Longint(#fr));
po.mEnd := fr.chrg.cpMin - 1;
po.rendRect := fr.rc;
if High(FPageOffsets) = -1 then SetLength(FPageOffsets, 1)
else
SetLength(FPageOffsets, Length(FPageOffsets) + 1);
FPageOffsets[High(FPageOffsets)] := po
end;
pageCount := Length(FPageOffsets);
SendMessage(TestEdit.Handle, EM_FORMATRANGE, 0, 0);
RestoreDC(fr.hdc, - 1);
// print.
Printer.BeginDoc;
fr.hdc := Printer.Handle;
fr.hdcTarget := Printer.Handle;
SaveDC(fr.hdc);
SetViewportOrgEx(fr.hdc, 0, 0, nil);
SetViewportExtEx(fr.hdc, TestEdit.Width ,testedit.Height , nil);
firstPage := True;
//select from page and to page
currPage := 0; //Print from the first page
pageCount := 1; //Only One page for testing REMOVE LATER!!!
while (currPage < pageCount) do
begin
if firstPage then
firstPage := False
else
Printer.NewPage;
SetViewportExtEx(fr.hdc, TestEdit.Width ,testedit.Height
, nil);
fr.rc := FPageOffsets[currPage].rendRect;
fr.rcPage := pageRect;
fr.chrg.cpMin := FPageOffsets[currPage].mStart;
fr.chrg.cpMax := FPageOffsets[currPage].mEnd;
fr.chrg.cpMin := SendMessage(TestEdit.Handle, EM_FORMATRANGE, 1, Longint(#fr));
Inc(currPage);
end;
SetViewportOrgEx(fr.hdc, 0, 0, nil);
//draw bounding rect
Printer.Canvas.MoveTo(outline.Left-2,outline.Top-2);
Printer.Canvas.LineTo(outline.Right+4,outline.Top-2);
Printer.Canvas.LineTo(outline.Right+4,outline.Bottom+4);
Printer.Canvas.LineTo(outline.Left-2,outline.Bottom+4);
Printer.Canvas.LineTo(outline.Left-2,outline.Top-2);
//restore the printer's HDC settings
RestoreDC(fr.hdc, - 1);
Printer.EndDoc;
// clear RichEdit control's formatting buffer
fr.chrg.cpMin := SendMessage(TestEdit.Handle, EM_FORMATRANGE, 0, 0);
//delete saved page table info
Finalize(FPageOffsets);
end;

Answer 1

I have finally found the answer (unfortunately by trial and error rather than logic). The following is the code I used for a similar situation:
procedure DoRTF(RTF: TRichedit);
var
r: TRect;
richedit_outputarea: TRect;
printresX, printresY: Real;
fmtRange: TFormatRange;
Ratio: Real;
ScaleFactor: Real;
begin
ScaleFactor:= 1;
Ratio:=GetDeviceCaps(printer.canvas.handle, LOGPIXELSX)/GetDeviceCaps(MainForm.canvas.handle, LOGPIXELSX);
//"r" is the position of the richedit on the printer page
r := Rect(badgerect.left+round((RTF.Left-WordsBottom.Left)*Ratio),
badgerect.Top+round((RTF.Top-WordsTop.Top)*Ratio),
badgerect.left+round((RTF.Left-WordsBottom.Left)*Ratio +RTF.width*Ratio),
badgerect.Top+round((RTF.Top-WordsTop.Top)*Ratio+RTF.Height*Ratio) );
SetMapMode( printer.canvas.handle, MM_ANISOTROPIC );
SetWindowExtEx(printer.canvas.handle,
GetDeviceCaps(printer.canvas.handle, LOGPIXELSX),
GetDeviceCaps(printer.canvas.handle, LOGPIXELSY),
nil);
SetViewportExtEx(printer.canvas.handle,
Round(GetDeviceCaps(printer.canvas.handle, LOGPIXELSX)*ScaleFactor ),
Round(GetDeviceCaps(printer.canvas.handle, LOGPIXELSY)*ScaleFactor ),
nil);
with Printer.Canvas do
begin
printresX := GetDeviceCaps( handle, LOGPIXELSX) ;
printresY := GetDeviceCaps( handle, LOGPIXELSY) ;
richedit_outputarea := Rect(
round(r.left * 1440 / printresX),
round(r.top * 1440 / printresY),
round(r.right * 1440 / printresX),
round(r.bottom* 1440 / printresY) );
fmtRange.hDC := Handle;
fmtRange.hdcTarget := Handle;
fmtRange.rc := richedit_outputarea;
fmtRange.rcPage:= Rect( 0, 0, round(Printer.PageWidth * 1440 / printresX) , round(Printer.PageHeight * 1440 / printresY) );
fmtRange.chrg.cpMin := 0;
fmtRange.chrg.cpMax := RTF.GetTextLen-1;
// format text
RTF.Perform(EM_FORMATRANGE, 1, Longint(#fmtRange));
// Free cached information
RTF.Perform(EM_FORMATRANGE, 0, 0);
end
end;