mORMot Open Source

RyanC

Member

From: Kettering, United Kingdom

Registered: 2013-01-17

Posts: 7

Code contribution for EMF Record EMR_FILLRGN

Hi All,

It has been a while since I posted but wanted to contribute some code back. I have been using SynPDF with THTMLView for a while but hit an issue with tables and HTML header and footers. First HTMLView table borders, when using SynPDF 1.18 I didn't get any standard table borders. Having checked the EMF output from HTMLView I discovered the borders are drawn using EMR_FILLRGN. Here is the code to add to EnumEMFFunc to deal with this EMF record:

  EMR_FILLRGN: begin
    // Code Copied from EMR_SELECTOBJECT
    if integer(PEMRFillRgn(R)^.ihBrush)<0 then begin // stock object?
      num := PEMRFillRgn(R)^.ihBrush and $7fffffff;
      case num of
        NULL_BRUSH:
          brush.null := true;
        WHITE_BRUSH..BLACK_BRUSH: begin
          brush.color := STOCKBRUSHCOLOR[num];
          brush.null := false;
        end;
        NULL_PEN: begin
          pen.style := PS_NULL;
          pen.null := true;
        end;
        WHITE_PEN, BLACK_PEN: begin
          pen.color := STOCKPENCOLOR[num];
          pen.null := false;
        end;
      end;
    end else
    if PEMRFillRgn(R)^.ihBrush-1<cardinal(length(E.Obj)) then // avoid GPF
      with E.Obj[PEMRFillRgn(R)^.ihBrush-1] do
      case Kind of // ignore any invalid reference
        OBJ_PEN: begin
          if E.fInLined and
            ((pen.color<>PenColor) or (pen.width<>PenWidth) or
             (pen.style<>PenStyle)) then begin
            E.fInLined := False;
            if not pen.null then
              E.Canvas.Stroke;
          end;
          pen.null := (PenWidth<0) or (PenStyle = PS_NULL); // !! 0 means as thick as possible
          pen.color := PenColor;
          pen.width := PenWidth;
          pen.style := PenStyle;
        end;
        OBJ_BRUSH: begin
          brush.null := BrushNull;
          brush.color := BrushColor;
          brush.style := BrushStyle;
        end;
        OBJ_FONT: begin
          font.spec := FontSpec;
          move(LogFont,font.LogFont,sizeof(LogFont));
        end;
      end;
    // New code to fill the region
    E.FillRectangle(PRgnDataHeader(@PEMRFillRgn(R)^.RgnData[0])^.rcBound);
  end;

The other issues I has was with converting the HTML to a PDF with HTML headers and footers. The sample code reference on this site, and others, make use of the THTMLView function MakePagedMetaFiles. Unfortunately this function doesn't support HTML headers and footers. To get around this I created my own Printer class which was derived from the ThtPrinter base class. With a small modification to HTMLView you can then pass this printer class into the standard Print function and get a PDF document with HTML headers and footers inserted correctly.

uses Forms, SysUtils, Classes, Graphics, vwPrint, SynPDF;

type
  TPDFPrinter = class(ThtPrinter)
  protected
    PDFDocGDI : TPdfDocumentGDI;
    function GetCanvas: TCanvas; override;
    function GetPageNum: integer; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    // Printer Methods
    procedure BeginDoc; override;
    procedure NewPage; override;
    procedure EndDoc; override;
    procedure Abort; override;
  end;

implementation

{ TPDFPrinter }

procedure TPDFPrinter.Abort;
begin
  Self.SetPrinting(False);
end;

procedure TPDFPrinter.BeginDoc;
var
  NewCanvas : TCanvas;
begin
  Self.SetPrinting(True);

  Self.PDFDocGDI.NewDoc;

  Self.PDFDocGDI.AddPage;

  NewCanvas := Self.GetCanvas;

  // This code replaces GetPrinterCapsOf
  FPPIX := Self.PDFDocGDI.ScreenLogPixels;
  FPPIY := Self.PDFDocGDI.ScreenLogPixels;
  FPaperWidth := Self.PDFDocGDI.VCLCanvasSize.cx;
  FPaperHeight := Self.PDFDocGDI.VCLCanvasSize.cy;
  FOffsetX := 0;
  FOffsetY := 0;
  FPgWidth := Self.PDFDocGDI.VCLCanvasSize.cx;
  FPgHeight := Self.PDFDocGDI.VCLCanvasSize.cy;
end;

constructor TPDFPrinter.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  PDFDocGDI := TPdfDocumentGDI.Create;
end;

destructor TPDFPrinter.Destroy;
begin
  FreeAndNil(PDFDocGDI);
  inherited;
end;

procedure TPDFPrinter.EndDoc;
begin
  Self.SetPrinting(False);
end;

function TPDFPrinter.GetCanvas: TCanvas;
begin
  Result := Self.PDFDocGDI.VCLCanvas;
end;

function TPDFPrinter.GetPageNum: integer;
begin
  Result := Self.PDFDocGDI.RawPages.Count;
end;

procedure TPDFPrinter.NewPage;
var
  NewCanvas : TCanvas;
begin
  Self.PDFDocGDI.AddPage;

  NewCanvas := Self.GetCanvas;
  NewCanvas.Brush.Color := clWhite;
  NewCanvas.Pen.Color := clWhite;
  NewCanvas.Brush.Style := bsSolid;
  NewCanvas.Rectangle(0, 0, Self.PDFDocGDI.DefaultPageWidth, Self.PDFDocGDI.DefaultPageHeight);

  NewCanvas.Font.PixelsPerInch := Screen.PixelsPerInch;
  NewCanvas.Font.Name := 'Arial';
  NewCanvas.Font.Size := 10;
  NewCanvas.Brush.Style := bsClear;
end;

Then all you do is call HTMLPrinter.Print(PDFPrinter, 1, HTMLPrinter.NumPrinterPages, ppPreview); to generate your PDF

EMF processing is all new to me so please update my code as you see fit.

Take care,
Ryan

Last edited by RyanC (2013-04-22 15:54:29)

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,242

Website

Re: Code contribution for EMF Record EMR_FILLRGN

I've added EMR_FILLRGN process, after your nice proposal.
See http://synopse.info/fossil/info/57a3fa05b2

As you can see, I have made some small code refactoring to share the object selection code per index for both EMR_FILLRGN and EMR_SELECTOBJECT.

Thanks a lot for your feedback, and especially the new printer class, which will help a lot for THTMLView.
By the way, do you use the latest version from https://code.google.com/p/thtmlviewer ? Sounds like if such a meta-printer may be worth integrating in the main version - or perhaps it is already available. May be they may be interresting in handling a direct SynPDF export in the mani THtlmView trunk. May be you can help contributing?

RyanC

Member

From: Kettering, United Kingdom

Registered: 2013-01-17

Posts: 7

Re: Code contribution for EMF Record EMR_FILLRGN

Hi Ab,

Your more than welcome I'm glad I can give something back. I do use the version from code.google.com although I'm using version 11.2 not 11.4 which is the latest version.

I've have opened a ticket on that project asking for two code changes if possible. The ticket number is 240. In that I mention this project and why I'm asking for the changes. If they make them then you don't need to rely on TMetaFilePrinter which is part of that project any more.

For those that want the modification to that project this is what I did:

File: vwPrinter.pas

Make all of the private variable protected i.e

  ThtPrinter = class(TComponent)
  private
    FOffsetX: Integer;      // Physical Printable Area x margin
    FOffsetY: Integer;      // Physical Printable Area y margin
    FPaperHeight: Integer;  // Physical Height in device units
    FPaperWidth: Integer;   // Physical Width in device units
    FPgHeight: Integer;     // Vertical height in pixels
    FPgWidth: Integer;      // Horizontal width in pixels
    FPPIX: Integer;         // Logical pixels per inch in X
    FPPIY: Integer;         // Logical pixels per inch in Y
    FPrinting: Boolean;
    FTitle: ThtString;      // Printed Document's Title
  protected
    function GetCanvas: TCanvas; virtual; abstract;
    function GetPageNum: Integer; virtual; abstract;
    procedure CheckPrinting(Value: Boolean);
    procedure GetPrinterCapsOf(Printer: TPrinter);
    procedure SetPrinting(Value: Boolean);
  public
    procedure BeginDoc; virtual; abstract;
    procedure NewPage; virtual; abstract;
    procedure EndDoc; virtual; abstract;
    procedure Abort; virtual; abstract;
    procedure Assign(Source: TPersistent); override;
    property Canvas: TCanvas read GetCanvas;
    property OffsetX: Integer read FOffsetX;
    property OffsetY: Integer read FOffsetY;
    property PageNumber: Integer read GetPageNum;
    property PageHeight: Integer read FPgHeight;
    property PageWidth: Integer read FPgWidth;
    property PaperHeight: Integer read FPaperHeight;
    property PaperWidth: Integer read FPaperWidth;
    property PixelsPerInchX: Integer read FPPIX;
    property PixelsPerInchY: Integer read FPPIY;
    property Printing: Boolean read FPrinting; // becomes True in BeginDoc and back to False in EndDoc.
    property Title: ThtString read FTitle write FTitle;
  end;

becomes

  ThtPrinter = class(TComponent)
  protected
    FOffsetX: Integer;      // Physical Printable Area x margin
    FOffsetY: Integer;      // Physical Printable Area y margin
    FPaperHeight: Integer;  // Physical Height in device units
    FPaperWidth: Integer;   // Physical Width in device units
    FPgHeight: Integer;     // Vertical height in pixels
    FPgWidth: Integer;      // Horizontal width in pixels
    FPPIX: Integer;         // Logical pixels per inch in X
    FPPIY: Integer;         // Logical pixels per inch in Y
    FPrinting: Boolean;
    FTitle: ThtString;      // Printed Document's Title
    function GetCanvas: TCanvas; virtual; abstract;
    function GetPageNum: Integer; virtual; abstract;
    procedure CheckPrinting(Value: Boolean);
    procedure GetPrinterCapsOf(Printer: TPrinter);
    procedure SetPrinting(Value: Boolean);
  public
    procedure BeginDoc; virtual; abstract;
    procedure NewPage; virtual; abstract;
    procedure EndDoc; virtual; abstract;
    procedure Abort; virtual; abstract;
    procedure Assign(Source: TPersistent); override;
    property Canvas: TCanvas read GetCanvas;
    property OffsetX: Integer read FOffsetX;
    property OffsetY: Integer read FOffsetY;
    property PageNumber: Integer read GetPageNum;
    property PageHeight: Integer read FPgHeight;
    property PageWidth: Integer read FPgWidth;
    property PaperHeight: Integer read FPaperHeight;
    property PaperWidth: Integer read FPaperWidth;
    property PixelsPerInchX: Integer read FPPIX;
    property PixelsPerInchY: Integer read FPPIY;
    property Printing: Boolean read FPrinting; // becomes True in BeginDoc and back to False in EndDoc.
    property Title: ThtString read FTitle write FTitle;
  end;

File: htmlview.pas

Search for the line:

function THtmlViewer.Print(Prn: ThtPrinter; FromPage: Integer; ToPage: Integer; Mode: ThtPrintPreviewMode): Integer;

Blow this you will find a case statement which reads:

  case Mode of
    ppAuto:
      if not (Prn is TMetaFilePrinter) then
        Mode := ppMultiPrint
      else
        Mode := ppPreview;

    ppPreview:
      if not (Prn is TMetaFilePrinter) then
        raise EIllegalArgument.CreateFmt('Previewing a print requires a printer based on TMetaFilePrinter but not a %s', [Prn.ClassName]);

    ppNoOutput:
      if not (Prn is TMetaFilePrinter) then
        raise EIllegalArgument.CreateFmt('Getting the total number of pages to print requires a printer based on TMetaFilePrinter but not a %s', [Prn.ClassName]);
  end;

Change it to

  case Mode of
    ppAuto:
      if not (Prn is ThtPrinter) then
        Mode := ppMultiPrint
      else
        Mode := ppPreview;

    ppPreview:
      if not (Prn is ThtPrinter) then
        raise EIllegalArgument.CreateFmt('Previewing a print requires a printer based on TMetaFilePrinter but not a %s', [Prn.ClassName]);

    ppNoOutput:
      if not (Prn is ThtPrinter) then
        raise EIllegalArgument.CreateFmt('Getting the total number of pages to print requires a printer based on TMetaFilePrinter but not a %s', [Prn.ClassName]);
  end;

This will allow anything derived from ThtPrinter to be used in this function.

I hope this helps people who need it.

The company I work for use HTMLView and SynPDF a lot on the projects we write for customers. As I come across issues and am able to fix them I'll post the code back. This is the first time I've been able to contribute something useful back to an open source project

Take care,
Ryan