Delphi Pages Forums  

Go Back   Delphi Pages Forums > Delphi Forum > General

Lost Password?

Reply
 
Thread Tools Display Modes
  #1  
Old 09-24-2016, 01:54 AM
Badger Badger is offline
Member
 
Join Date: Aug 2013
Location: Sheffield, Tasmania (Aust)
Posts: 76
Default scale font when printing richedit

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?

Badger (A bad tempered beast that sleeps most of the winter)

Code:
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;
Reply With Quote
Reply

Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is On

Forum Jump


All times are GMT. The time now is 09:31 AM.


Powered by vBulletin® Version 3.8.8
Copyright ©2000 - 2019, vBulletin Solutions, Inc.