mORMot Open Source

  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;

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;

var
   PageCount: Integer;
begin
  // Other printing preparation code goes here

  // Force the printout to regenerate
  Self.dxGridLink.RebuildReport;
  // Copy each page to the PDF document
  for PageCount := 0 To dxComponentPrinter1.GetPageCount - 1 do begin
    dxComponentPrinter1.EnumPagesAsImages([PageCount], TMetaFile, False, PDFPrinter.AppendDevExpressGrid, nil, nil, nil);
  end;

type
  TDevExpress2SynPDF = class(TPdfDocumentGDI)
  private
  public
    constructor Create(AUseOutlines: Boolean=false; ACodePage: integer=0; APDFA1: boolean=false);
    destructor Destroy; override;
    procedure AppendDevExpressGrid(AComponentPrinter: TCustomdxComponentPrinter; AReportLink: TBasedxReportLink; 
                                   AIndex, APageIndex: Integer; const AGraphic: TGraphic; 
                                   AData: Pointer; var AContinue: Boolean);
  end;

implementation

uses SynGdiPlus;

procedure TDevExpress2SynPDF.AppendDevExpressGrid(
  AComponentPrinter: TCustomdxComponentPrinter; AReportLink: TBasedxReportLink;
  AIndex, APageIndex: Integer; const AGraphic: TGraphic; AData: Pointer;
  var AContinue: Boolean);
var
  Emf     : TMetafile;
  R       : TRect;
  PdfPage : TPdfpage;
begin
  if AGraphic is TMetaFile then begin
    Emf := AGraphic as TMetaFile;

    // Make this page landscape
    PdfPage := Self.AddPage;
    PdfPage.PageWidth := Self.DefaultPageHeight;
    PdfPage.PageHeight := Self.DefaultPageWidth;

    R.Left := 0;
    R.Top := 0;
    R.Bottom := Emf.Height;
    R.Width := Emf.Width;
    Gdip.DrawAntiAliased(Emf, Self.VCLCanvas.Handle, R, smAntiAlias, trhClearTypeGridFit);
  end;
end;

constructor TDevExpress2SynPDF.Create(AUseOutlines: Boolean; ACodePage: integer;
  APDFA1: boolean);
begin
  inherited Create(AUseOutlines, ACodePage, APDFA1);

  Gdip := TGDIPlusFull.Create;
end;

destructor TDevExpress2SynPDF.Destroy;
begin
  FreeAndNil(Gdip);
  inherited;
end;