qrpdffilt.pas

delphi7报表打印控件源码 可以设计报表

unit QRPDFFilt;
////////////////////////////////////////////////////////////////////////////
//  Unit : QRPDFFilt.pas
//
//  TQRGAbstractExportFilter -> TQRPDFDocumentFilter                    
//
//  The new PDF Export document filter class -
//
//  (c) 2001 QBS Software
//      created 28th September 2001
//   17/11 fix stretch ug with TQRGRImage - now stretchraw in control rect
//   25/11 Added proprtional control to PDF
//   11/01/02 added Inside proportional mode
//   14/02/02 add top margin adjust and left m adjust
//
//   REVISION to V2.0 - 21-06-02
//   QRDBImage, QRImage and QRShape now supported.
//   9/9/02 SetTempPath added.
//   22/01/03 fixed Nil db image bug.
//   15/01/03 added compression
//   15/03/03 added DocumentInfo
//   6/08/03  MSL added SetConatenating
//   30/10/03 fixed path on temp image file
//   28/12/2003 added TrueType embedding
////////////////////////////////////////////////////////////////////////////
{$define VER20}
{$define notUSE_DLL}
interface
{$ifdef USE_DLL}
uses windows, classes, controls, stdctrls,sysutils, graphics, buttons,
     forms, extctrls, dialogs, printers, db, DBtables, ComCtrls, qrexport,
     QRPrntr, Quickrpt, QR4Const, qrctrls, grimgctrl;
{$else}
uses windows, classes, controls, stdctrls,sysutils, graphics, buttons,
     forms, extctrls, dialogs, printers, db, DBtables, ComCtrls, qrexport,
     QRPrntr, Quickrpt, QR4Const, qrctrls, grimgctrl, pdfobjs;
{$endif}
 
const
    PointsPerMM = 72.0 / 25.4;
  IT_TEXT = 1;
  IT_NEWPAGE = 2;
  IT_GRAPHIC = 3;
  IT_IMAGE = 4;
  // shapes
  S_BOX = 0;
  S_CIRCLE = 1;
  S_HLINE = 2;
  S_VLINE = 3;
  S_OBLIQUE = 4;
  S_TOPBOTTOM = 5;
  S_LEFTRIGHT = 6;
  S_ROUNDRECT = 7;
  // ascii
  ORD0 = ord('0');
  ORDA = ord('A');

type
{$ifdef USE_DLL}
  TRGBColor = record
      red, green, blue : byte;
  end;

  TPDFItemRec = record
      ItemType : byte;
      Xpos, Ypos : extended;
      Fontname, FText : pchar;
      fontsize : integer;
      fcolor : pchar;
      fbold, fitalic : boolean;
      fAlignment : byte;
      // extra for graphic item
      filled, staticimage : boolean;
      width, height, thickness, xscale, yscale : extended;
      imagesrc : pchar;
      imagestream : TMemoryStream;
      shape : byte;
      pixelwidth, pixelheight : integer;
      rgbstrokecolor : TRGBColor;
      rgbfcolor : TRGBColor;
  end;
{$endif}

  TQRPAbstractExportFilter = class(TQRExportFilter)
  private
    FStream : TStream;
    FCharWidth,
    FCharHeight,
    FPaperWidth,
    FPaperHeight : extended;
    FLineCount,
    FColCount : integer;
    FPageProcessed : boolean;
  protected
    function GetText(X, Y : extended; var Font : TFont) : string;
    function GetFilterName : string; override;
    function GetDescription : string; override;
    function GetExtension : string; override;
    procedure WriteToStream(const AText : string);
    procedure WriteLnToStream(const AText : string);
    procedure CreateStream(Filename : string); virtual;
    procedure CloseStream; virtual;
    procedure ProcessPage; virtual;
    procedure StorePage; virtual;
    property Stream : TStream read FStream write FStream;
    property PageProcessed : boolean read FPageProcessed write FPageProcessed;
    property CharWidth : extended read FCharWidth write FCharWidth;
    property CharHeight : extended read FCharHeight write FCharHeight;
    property PaperWidth : extended read FPaperWidth write FPaperWidth;
    property PaperHeight : extended read FPaperHeight write FPaperHeight;
    property LineCount : integer read FLineCount write FLineCount;
    property ColCount : integer read FColCount write FColCount;
  public
    constructor Create( filename : string );override;
    procedure Start(PaperWidth, PaperHeight : integer; Font : TFont); override;
    procedure Finish; override;
    procedure EndPage; override;
    procedure NewPage; override;
    procedure AcceptGraphic( Xoff, Yoff : extended; GControl : TControl); override;
    procedure TextOut(X, Y : extended; Font : TFont; BGColor : TColor;
               Alignment : TAlignment; Text : string); override;
  end;

  TQRPDFDocumentFilter = class(TQRPAbstractExportFilter)
  private
    FFreeStream : boolean;
    FBodyColor : TColor;
    FFirstPage : boolean;
    FPageLength : integer;
    FPageNumber : longint;
    FNextPicnum : longint;
    FPDFItem : TPDFItemRec;
    FReportnum : integer;
    FLeftMargin : integer;
    FTopMargin : integer;
    PDFConcatenating : boolean;
    PDFTextOnTop : boolean;
    FCharset: TFontCharset;
    procedure SetTextOnTop( bval : boolean );
    procedure SetConcatenating( p_Value:Boolean );
    procedure ChangeCompression( cval : boolean );
    function getCompressionOn : boolean;
    function getConcatenating  : boolean;
    function getTextOnTop : boolean;
  protected
    function GetFilterName : string; override;
    function GetDescription : string; override;
    function GetExtension : string; override;
    function GetStreaming : boolean; override;
    procedure CreateStream(Filename : string); override;
    procedure CloseStream; override;
  public
    constructor Create( filename : string );override;
    destructor Destroy; override;
    procedure SetCharset( value : TFontCharset);
    procedure StorePage; override;
    procedure TextOut(X, Y : extended; Font : TFont; BGColor : TColor;
               Alignment : TAlignment; Text : string); override;
    procedure ProcessPage; override;
    procedure Start(PaperWidth, PaperHeight : integer; Font : TFont); override;
    procedure Finish; override;
    procedure SetMargins( TopMarg, Leftmarg : integer );
    procedure NewPage; override;
    procedure EndPage; override;
    procedure EndConcat;
    procedure AcceptGraphic( Xoff, Yoff : extended; GControl : TControl); override;
    procedure SetCompression( OnOff : boolean );
    procedure SetDocumentInfo( author, title, subject : string );
    procedure AddFontMap( ssmap : string );
    procedure AddTTFont( fontname : string );
    property PageLength : integer read FPageLength write FPageLength;
    property Stream;
    property FreeStream : boolean read FFreeStream write FFreeStream;
    property TextOnTop : boolean read getTextOnTop write SetTextOnTop;
    property Concatenating : boolean read getConcatenating write SetConcatenating;
    property Reportnum : integer read FReportnum write FReportnum;
    property TopMargin : integer read FTopMargin write FTopMargin;
    property LeftMargin : integer read FLeftMargin write FLeftMargin;
    property CompressionOn : boolean read getCompressionOn write ChangeCompression;
    property Charset: TFontCharset read FCharset write SetCharset;
  end;

  TQRPDFFilter = class(TComponent)
  protected
    procedure ChangeCompression( cval : boolean );
    function getCompressionOn : boolean;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
     property CompressionOn : boolean read getCompressionOn write ChangeCompression;
  end;


  procedure RunLength(Source, Target: TStream);
  procedure AsciiHex(Source: TStream; imgfilename : string);
  procedure AsciiHexToString(Source: TStream; var outstr : string);
  procedure Hexit( var c1 : char; var c2 : char; b : byte );

implementation
var
    MMperpixelX, MMperpixelY, PointsPerPixelX, PointsPerPixelY : extended;
    PDFCompressionOn : boolean;
{$ifdef USE_DLL}
   procedure CloseDownLib; external 'QRPdfLib.dll';
   procedure InitLib( Mother : pointer ); external 'QRPdfLib.dll';
   procedure AddPDFItem( ItemRec : TPDFItemRec ); external 'QRPdfLib.dll';
   procedure AddImageItem( ItemRec : TPDFItemRec; imgdata : pointer ); external 'QRPdfLib.dll';
   Procedure SetPageParams( w, h, tm, tma, lma : extended ); external 'QRPdfLib.dll';
   Procedure AddFontSub( ssmap : string ); external 'QRPdfLib.dll';
   Procedure EmbedTTFont( fontname : string ); external 'QRPdfLib.dll';
   procedure FinishDoc( FOutFile : string ); external 'QRPdfLib.dll';
   procedure SetTextFirst( bval : boolean ); external 'QRPdfLib.dll';
   procedure SetFiltCompression( con : integer ); external 'QRPdfLib.dll';
   procedure SetDocProperties( author, title, subject : string ); external 'QRPdfLib.dll';
{$endif}

constructor TQRPDFFilter.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  QRExportFilterLibrary.AddFilter(TQRPDFDocumentFilter);
end;

destructor TQRPDFFilter.Destroy;
begin
  QRExportFilterLibrary.RemoveFilter(TQRPDFDocumentFilter);
  inherited Destroy;
end;
function TQRPDFFilter.getCompressionOn : boolean;
begin
    result := PDFCompressionOn;
end;
procedure TQRPDFFilter.ChangeCompression( cval : boolean );
begin
    PDFCompressionOn := cval;
end;

{TQRPAbstractExportFilter}
constructor TQRPAbstractExportFilter.Create( filename : string );
begin
    inherited Create( filename);
end;

procedure TQRPAbstractExportFilter.AcceptGraphic( Xoff, Yoff : extended; GControl : TControl);
begin
end;

function TQRPAbstractExportFilter.GetFilterName : string;
begin
  result := 'QRAbstract'; // Do not translate
end;

function TQRPAbstractExportFilter.GetDescription : string;
begin
  Result := '';
end;

function TQRPAbstractExportFilter.GetExtension : string;
begin
  Result := '';
end;

procedure TQRPAbstractExportFilter.Start(PaperWidth, PaperHeight : integer; Font : TFont);
begin
   // see override
   inherited Start( paperwidth, paperheight, font );
end;


procedure TQRPAbstractExportFilter.CreateStream(Filename : string);
begin
  FStream := TFileStream.Create(Filename, fmCreate);
end;

procedure TQRPAbstractExportFilter.CloseStream;
begin
  FStream.Free;
end;

procedure TQRPAbstractExportFilter.WriteToStream(const AText : string);
begin
  Stream.Write(AText[1], length(AText));
end;

procedure TQRPAbstractExportFilter.WriteLnToStream(const AText : string);
begin
  WriteToStream(AText + #13 + #10);
end;


procedure TQRPAbstractExportFilter.Finish;
begin
    // all in override
    inherited;
end;

procedure TQRPAbstractExportFilter.NewPage;
begin
   // all in override
end;

procedure TQRPAbstractExportFilter.EndPage;
begin
  // all in override
end;

procedure TQRPAbstractExportFilter.ProcessPage;
begin
  FPageProcessed := True;
end;

procedure TQRPAbstractExportFilter.StorePage;
begin
end;

procedure TQRPAbstractExportFilter.TextOut(X, Y : extended; Font : TFont;
                      BGColor : TColor; Alignment : TAlignment; Text : string);
begin
end;

function TQRPAbstractExportFilter.GetText(X, Y : extended; var Font : TFont) : string;
begin
end;

{TQRPDFDocumentFilter}
function TQRPDFDocumentFilter.getCompressionOn : boolean;
begin
    result := PDFCompressionOn;
end;
procedure TQRPDFDocumentFilter.ChangeCompression( cval : boolean );
begin
    SetCompression( cval );
    PDFCompressionOn := cval;
end;

function TQRPDFDocumentFilter.getConcatenating  : boolean;
begin
    result := PDFConcatenating;
end;
function TQRPDFDocumentFilter.getTextOnTop : boolean;
begin
    result := PDFTextOnTop;
end;
procedure TQRPDFDocumentFilter.SetConcatenating( p_Value:Boolean );