rm_e_pdf.pas

report machine 2.3 功能强大

unit RM_e_pdf;

interface

{$I RM.INC}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, RM_Class, RM_E_Main
{$IFDEF JPEG}, JPEG{$ENDIF}
{$IFDEF ZLib}, ZLib{$ENDIF};

type

  TRMPDFCompressionMethod = (rmcmNone, rmcmFastest, rmcmNormal, rmcmMaxCompress);

 { TRMPDFExport }
  TRMPDFExport = class(TRMExportFilter)
  private
    FCompressionMethod: TRMPDFCompressionMethod;
    FImageStream: TStream;
    FStream: TStream;
    FImageCtlList: TStrings;
    FImageXRefList: TStrings;
    FObjRunNo: Integer;
    FPageObjNo: Integer;
    FContentsObjNo: Integer;
    FLengthObjNo: Integer;
    FPageObjs: string;
    FXRefTable: TStrings;
    FPixelFormat: TPixelFormat;
    FExportImageFormat: TRMEFImageFormat;
{$IFDEF JPEG}
    FJPEGQuality: TJPEGQualityRange;
{$ENDIF}
    FPageNo: Integer;
    FPageWidth, FPageHeight: Integer;
    FPageVisible: Boolean;

    procedure DrawbkPicture(aCanvas: TCanvas);
    procedure SetExportImageFormat(const Value: TRMEFImageFormat);
    function CompressStream(InputStream, OutputStream: TStream): Integer;
    function MakeObjHead(ObjNo: Integer): string;
    function MakeObjRef(ObjNo: Integer): string;
    function GetNewObjNo: Integer;
    function GetNativeXPos(X: Extended): Extended;
    function NumToStr(N: Extended): string;
    procedure WriteToStream(AText: string);
    procedure WriteToImageStream(AText: string);
    procedure AppendXRef(APos, ObjNo: Integer);
    procedure WriteObj(const S: string; ObjNo: Integer; IsObjectComplete: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    function ShowModal: Word; override;
    procedure OnBeginDoc; override;
    procedure OnEndDoc; override;
    procedure OnBeginPage; override;
    procedure OnEndPage; override;
  published
    property CompressionMethod: TRMPDFCompressionMethod read FCompressionMethod write FCompressionMethod default rmcmMaxCompress;
    property PixelFormat: TPixelFormat read FPixelFormat write FPixelFormat default pf24bit;
    property ExportImageFormat: TRMEFImageFormat read FExportImageFormat write SetExportImageFormat default ifBMP;
{$IFDEF JPEG}
    property JPEGQuality: TJPEGQualityRange read FJPEGQuality write FJPEGQuality default High(TJPEGQualityRange);
{$ENDIF}
  end;

  { TRMPDFExportForm }
  TRMPDFExportForm = class(TForm)
    btnOK: TButton;
    btnCancel: TButton;
    gbExportImages: TGroupBox;
    lblExportImageFormat: TLabel;
    lblJPEGQuality: TLabel;
    cbImageFormat: TComboBox;
    edJPEGQuality: TEdit;
    UpDown1: TUpDown;
    lblCompressionLevel: TLabel;
    cbCompressionLevel: TComboBox;
    Label4: TLabel;
    cmbPixelFormat: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure cbImageFormatChange(Sender: TObject);
    procedure edJPEGQualityKeyPress(Sender: TObject; var Key: Char);
    procedure FormShow(Sender: TObject);
  private
  protected
    procedure Localize;
  public
  end;

implementation

{$R *.DFM}

uses RM_CmpReg, RM_Const, RM_Utils;

const
  CR = #13;
  CRLF = #13#10;
  CRootObjNo = 1;
  CPagesTreeObjNo = 2;
  CInfoObjNo = 3;
  CProcSetObjNo = 4;
  CInchToPoint = 72; // multiply by
  CResourcesObjNo = 5;
  CLastReservedObjNo = 5;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMPDFExport}

constructor TRMPDFExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ShowDialog := True;
  FPixelFormat := pf24bit;
  FExportImageFormat := ifBMP;
  FCompressionMethod := rmcmMaxCompress;
{$IFDEF JPEG}
  FJPEGQuality := High(TJPEGQualityRange);
{$ENDIF}

  RMRegisterExportFilter(Self, RMLoadStr(SPDFFile), '*.pdf');
end;

function TRMPDFExport.ShowModal: Word;
begin
  if not ShowDialog then
    Result := mrOk
  else
  begin
    with TRMPDFExportForm.Create(nil) do
    begin
      try
        cbImageFormat.ItemIndex := cbImageFormat.Items.IndexOfObject(TObject(Ord(ExportImageFormat)));
        cmbPixelFormat.ItemIndex := Integer(Self.PixelFormat);
        if cbImageFormat.ItemIndex < 0 then cbImageFormat.ItemIndex := 0;
        cbCompressionLevel.ItemIndex := Integer(Self.FCompressionMethod);
        if cbCompressionLevel.ItemIndex < 0 then cbCompressionLevel.ItemIndex := 0;
{$IFDEF JPEG}
        UpDown1.Position := JPEGQuality;
{$ENDIF}
        Result := ShowModal;
        if Result = mrOK then
        begin
          Self.ExportImageFormat := TRMEFImageFormat(cbImageFormat.Items.Objects[cbImageFormat.ItemIndex]);
          Self.PixelFormat := TPixelFormat(cmbPixelFormat.ItemIndex);
          Self.FCompressionMethod := TRMPDFCompressionMethod(cbCompressionLevel.ItemIndex);
{$IFDEF JPEG}
          Self.JPEGQuality := StrToInt(edJPEGQuality.Text);
{$ENDIF}
        end;
      finally
        Free;
      end;
    end;
  end;
end;

function TRMPDFExport.CompressStream(InputStream, OutputStream: TStream): Integer;
{$IFDEF ZLib}
var
  CmprStream: TCompressionStream;
{$ENDIF}
begin
  Result := InputStream.Size;
{$IFDEF ZLib}
  if FCompressionMethod <> rmcmNone then
  begin
    CmprStream := TCompressionStream.Create(TCompressionLevel(CompressionMethod), OutputStream);
    try
      Result := OutputStream.Size;
      InputStream.Position := 0;
      CmprStream.Write(TMemoryStream(InputStream).Memory^, InputStream.Size);
    finally
      CmprStream.Free;
      Result := OutputStream.Size - Result;
    end;
  end
  else
    OutputStream.CopyFrom(InputStream, 0);
{$ELSE}
  OutputStream.CopyFrom(InputStream, 0);
{$ENDIF}
end;

function TRMPDFExport.MakeObjHead(ObjNo: Integer): string;
begin
  Result := IntToStr(ObjNo) + ' 0 obj';
end;

function TRMPDFExport.MakeObjRef(ObjNo: Integer): string;
begin
  Result := IntToStr(ObjNo) + ' 0 R';
end;

function TRMPDFExport.GetNewObjNo: Integer;
begin
  Inc(FObjRunNo);
  Result := FObjRunNo;
end;

function TRMPDFExport.GetNativeXPos(X: Extended): Extended;
begin
  Result := X / Screen.PixelsPerInch * CInchToPoint;
end;

function TRMPDFExport.NumToStr(N: Extended): string;
begin
  Result := FloatToStrF(N, ffFixed, 18, 4);
  if DecimalSeparator <> '.' then
    Result := RMReplaceString(Result, DecimalSeparator, '.');
end;

procedure TRMPDFExport.WriteToStream(AText: string);
begin
  Stream.Write(Pointer(AText)^, Length(AText));
end;

procedure TRMPDFExport.WriteToImageStream(AText: string);
begin
  FImageStream.Write(Pointer(AText)^, Length(AText));
end;

procedure TRMPDFExport.AppendXRef(APos, ObjNo: Integer);
begin
  FXRefTable.AddObject(IntToStr(APos), TObject(ObjNo));
end;

procedure TRMPDFExport.WriteObj(const S: string; ObjNo: Integer;
  IsObjectComplete: Boolean);
var
  ObjText: string;
begin
  ObjText := S;
  if Pos(CRLF, ObjText) <> 0 then
    ObjText := '<<' + CRLF + ObjText + CRLF + '>>';
  ObjText := MakeObjHead(ObjNo) + CRLF + ObjText + CRLF;
  if IsObjectComplete then
    ObjText := ObjText + 'endobj' + CRLF;
  AppendXRef(Stream.Size, ObjNo);
  WriteToStream(ObjText);
end;

procedure TRMPDFExport.DrawbkPicture(aCanvas: TCanvas);
var
  lbkPic: TRMbkPicture;
  lPic: TPicture;
  r1: TRect;
begin
  lbkPic := CurReport.EMFPages.bkPictures[CurReport.EMFPages[FPageNo].bkPictureIndex];
  if lbkPic = nil then Exit;

  lPic := lbkPic.Picture;
  if lPic.Graphic <> nil then
  begin
    r1 := Rect(0, 0, FPageWidth, FPageHeight);
    OffsetRect(r1, lbkPic.Left, lbkPic.Top);
    RMPrintGraphic(aCanvas, r1, lPic.Graphic, False);
  end;
end;

procedure TRMPDFExport.OnBeginDoc;
var
  S: string;
begin
  FPageNo := 0;
  FPageWidth := CurReport.EMFPages[0].PrnInfo.Pgw;
  FPageHeight := CurReport.EMFPages[0].PrnInfo.Pgh;

//  inherited OnBeginDoc;

  FImageStream := TMemoryStream.Create;
  FStream := TMemoryStream.Create;

  FImageCtlList := TStringList.Create;
  FImageXRefList := TStringList.Create;
  FXRefTable := TStringList.Create;

  FPageObjs := '';
  FObjRunNo := cLastReservedObjNo;

 // write header
  S := '%PDF-1.3' + CRLF;
  WriteToStream(S);

 // write Root object
  S := '/Type /Catalog' + CRLF + '/Pages ' + MakeObjRef(cPagesTreeObjNo);
  WriteObj(S, cRootObjNo, True);
end;

procedure TRMPDFExport.OnBeginPage;
begin
  FPageVisible := CurReport.EMFPages[FPageNo].Visible;
  CurReport.EMFPages[FPageNo].Visible := True;

//  inherited OnBeginPage;

  FImageXRefList.Clear;
  TMemoryStream(FImageStream).Clear;
  TMemoryStream(FStream).Clear;

  FPageObjNo := GetNewObjNo;
  FContentsObjNo := GetNewObjNo;
  FPageObjs := FPageObjs + ' ' + MakeObjRef(FPageObjNo);
  FLengthObjNo := GetNewObjNo;
end;

procedure TRMPDFExport.OnEndDoc;

  function MakeXRef(Offset: Integer;
    GenNum: Integer; fn: Char): string;
  begin
    Result := Format('%.10d %.5d %s', [Offset, GenNum, fn]);
  end;

var
  S, ZoneBias: string;