Measure/Units/ReportPdfHelper.pas

unit ReportPdfHelper;

interface

uses
  classes, PrintCom, PDF;

type
  TReportPdfHelper = class
  private
  public
    procedure ExportPages(APrintCom: TPrintCom; const AFileName: string; ABeginPage, AEndPage: Integer);
    procedure ExportAllPages(APrintCom: TPrintCom; const AFileName: string);
  end;

function PdfHelper: TReportPdfHelper;

implementation

uses
  Windows, SysUtils, Forms, Controls;

var _ReportPdfHelper: TReportPdfHelper;

function PdfHelper: TReportPdfHelper;
begin
  if not Assigned(_ReportPdfHelper) then
    _ReportPdfHelper := TReportPdfHelper.Create;
  Result := _ReportPdfHelper;
end;

{ TReportPdfHelper }

procedure TReportPdfHelper.ExportAllPages(APrintCom: TPrintCom;
  const AFileName: string);
begin
  ExportPages(APrintCom, AFileName, 1, APrintCom.TotalPages);
end;

procedure TReportPdfHelper.ExportPages(APrintCom: TPrintCom;
  const AFileName: string; ABeginPage, AEndPage: Integer);
var
  sPdf: TPDFDocument;
  iPage, iImage, I: Integer;
begin
  Screen.Cursor := crHourGlass;
  sPdf := TPDFDocument.Create(nil);
  try
    I := GetDeviceCaps(sPdf.UsedDC, LOGPIXELSX);

    sPdf.AutoLaunch := False;
    sPdf.DocumentInfo.CreationDate := Now;
    sPdf.FileName := AFileName;
    sPdf.PageLayout := plSinglePage;
    sPdf.BeginDoc;
    for iPage := 0 to AEndPage - ABeginPage do
    begin
      if sPdf.PageCount <= iPage then
        sPdf.NewPage
      else
        sPdf.SetCurrentPage(iPage);

      if sPdf.PageHeight <> APrintCom.PrintHeight then
        sPdf.CurrentPage.Height := MulDiv(APrintCom.PrintHeight, 72, I);
      if sPdf.PageWidth <> APrintCom.PrintWidth then
        sPdf.CurrentPage.Width := MulDiv(APrintCom.PrintWidth, 72, I);

      APrintCom.PrintPreviewCanvas(ABeginPage + iPage, 0, sPdf.Canvas, false);
    end;
    sPdf.EndDoc;
  finally
    sPdf.Free;
    Screen.Cursor := crDefault;
  end;
end;

initialization

finalization
  _ReportPdfHelper.Free;

end.