Search code examples
delphidelphi-xe5richedit

scale font when printing richedit XE5


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;

Solution

  • 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;