qexport4pdf.pas

Advanced.Export.Component.v4.01.rar,delphi 第三方控件

unit QExport4PDF;

interface

{$I VerCtrl.inc}

uses Classes, SysUtils, DB, QExport4, QExport4Types{$IFDEF VCL6}, Variants{$ENDIF}

  {$IFDEF WIN32}
    , Windows {$IFNDEF NOGUI}, Graphics{$ELSE}, QExport4Graphics{$ENDIF}
  {$ENDIF}
  {$IFDEF LINUX}
    , Types {$IFNDEF NOGUI}, QGraphics{$ELSE}, QExport4Graphics{$ENDIF}
  {$ENDIF};

type

  TPDFFontName = (poHelvetica, poHelveticaBold, poHelveticaOblique,
    poHelveticaBoldOblique, poCourier, poCourierBold, poCourierOblique,
    poCourierBoldOblique, poTimesRoman, poTimesBold, poTimesItalic,
    poTimesBoldItalic, poSymbol, poZapfDingbats);

  TPDFFontEncoding = (poStandardEncoding, poWinAnsiEncoding,
    poMacRomanEncoding, poPDFDocEncoding);

  TPDFBox = class;

  TPDFFont = class(TPersistent)
  private
    FFontName: string;
    FFontEncoding: TPDFFontEncoding;
    FUserFont: TFont;
    FWidths: array of integer;
    FUseUserFont: Boolean;

    FBaseFont: TPDFFontName;
    FFontSize: integer;
    FFontColor: TColor;

    procedure SetFont(const Value: TFont);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property FontName: string read FFontName write FFontName;
    function GetWidth(Numb: Integer): Integer;
    function ReturnFontLength: Integer;
    procedure CalcFontWidth;
  published
    property FontEncoding: TPDFFontEncoding read FFontEncoding
      write FFontEncoding default poWinAnsiEncoding;
    property UserFont: TFont read FUserFont write SetFont;

    property BaseFont: TPDFFontName read FBaseFont write FBaseFont
      default poHelvetica;
    property FontSize: integer read FFontSize write FFontSize default 10;
    property FontColor: TColor read FFontColor write FFontColor
      default clBlack;
    property UseUserFont: Boolean read FUseUserFont write FUseUserFont
      default false;  
  end;

  TPDFDocument = class(TComponent)
  private
    FPDFFile: TStream;
    FPageContents: TStringList;
    FStreamBegin: integer;
    FObjOffsets: TStringList;
    FFonts: TStringList;
    FObjNumber: integer;
    FFont: TPDFFont;
    FLineWidth: double;
    FLineSpacing: double;
    FLineColor: TColor;
    FFillColor: TColor;

    FMediaBox: TPDFBox;
    FTrimBox: TPDFBox;

    function AddObj: integer;
    procedure WriteStr2PDF(Source: string);
    procedure WriteBOF;
    //procedure WriteInfo;
    function WriteCatalog(PagesNum, OutLinesNum: integer): integer;
    function WriteOutLines: integer;
    function WriteResources : integer;
    function WritePages(FontsObj: integer): integer;
    function WriteXref: integer;
    procedure WriteTrailer(CatalogNum: integer; XrefOffset: integer);
    procedure WriteEof;
    procedure SetFont(Value: TPDFFont);
    function GetMediaBox: TPDFBox;
    function GetTrimBox: TPDFBox;
    procedure SetMediaBox(const Value: TPDFBox);
    procedure SetTrimBox(const Value: TPDFBox);
  public
    //constructor Create(AOwner: TComponent; Stream: TStream);
    constructor CreateWithStream(AOwner: TComponent; Stream: TStream);
    destructor Destroy; override;
    procedure BeginDoc;
    procedure EndDoc;
    procedure AddFont(NewFont: TPDFFont);
    procedure NewPage;
    procedure EndPage;
    procedure StringOut(x, y: integer; const Str: string; Color: TColor);
    procedure TextOut(x, y: integer; const Text: TStrings);
    procedure Line(x1, y1, x2, y2: double; Color: TColor);
    procedure FillRect(x1, y1, x2, y2: double; Color: TColor);
    procedure SetTextFont(Value: TPDFFont);
    function ChangeFillColor(Color: TColor): TColor;
    function ChangeLineColor(Color: TColor): TColor;
  published
    property ObjNumber: integer read FObjNumber;
    property Font: TPDFFont read FFont write SetFont;
    property LineWidth: double read FLineWidth write FLineWidth;
    property LineSpacing: double read FLineSpacing write FLineSpacing;
    property LineColor: TColor read FLineColor;
    property FillColor: TColor read FFillColor;

    property MediaBox: TPDFBox read GetMediaBox write SetMediaBox;
    property TrimBox: TPDFBox read GetTrimBox write SetTrimBox;
  end;

  TQPDFWriter = class(TQExportWriter)
  private
    FPDFDocument: TPDFDocument;
  public
    constructor Create(AOwner: TQExport4; AStream: TStream); override;
    destructor Destroy; override;
  published
    property PDFDocument: TPDFDocument read FPDFDocument;
  end;

  TPDFBox = class(TPersistent)
  private
    FLeft, FBottom, FRight, FTop: integer;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property Left: integer read FLeft write FLeft;
    property Bottom: integer read FBottom write FBottom;
    property Right: integer read FRight write FRight;
    property Top: integer read FTop write FTop;
  end;

  TQExportPDFPageOptions = class(TPersistent)
  private
    FUnits: TQExportUnits;
    FFormat: TQExportPageFormat;
    FWidth: integer;
    FHeight: integer;
    FOrientation: TQExportPageOrientation;
    FMarginLeft: integer;
    FMarginRight: integer;
    FMarginTop: integer;
    FMarginBottom: integer;

    FMediaBox: TPDFBox;
    FTrimBox: TPDFBox;

    procedure SetFormat(const Value: TQExportPageFormat);
    function IsWidth: boolean;
    function GetWidth: double;
    procedure SetWidth(const Value: double);
    function IsHeight: boolean;
    function GetHeight: double;
    procedure SetHeight(const Value: double);
    procedure SetOrientation(const Value: TQExportPageOrientation);
    function GetMarginLeft: double;
    procedure SetMarginLeft(const Value: double);
    function GetMarginRight: double;
    procedure SetMarginRight(const Value: double);
    function GetMarginTop: double;
    procedure SetMarginTop(const Value: double);
    function GetMarginBottom: double;
    procedure SetMarginBottom(const Value: double);
    function GetMediaBox: TPDFBox;
    function GetTrimBox: TPDFBox;
  protected
    property MediaBox: TPDFBox read GetMediaBox;
    property TrimBox: TPDFBox read GetTrimBox;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    // 项