qrpdffilt.pas

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

begin
     PDFConcatenating := p_Value;
end;

procedure TQRPDFDocumentFilter.AddFontMap( ssmap : string );
begin
     AddFontSub( ssmap );
end;

procedure TQRPDFDocumentFilter.SetDocumentInfo( author, title, subject : string );
begin
    SetDocProperties( author, title, subject );
end;

procedure TQRPDFDocumentFilter.AddTTFont( fontname : string );
begin
    EmbedTTFont( fontname);
end;

procedure TQRPDFDocumentFilter.SetCharset( value : TFontCharset);
begin
     FCharset := value;
     // call pdfobjs unit
     SelectCharset( value);
end;

procedure TQRPDFDocumentFilter.SetCompression( OnOff : boolean );
var
   ion : integer;
begin
     if OnOff then
       ion := 1
     else
       ion := 0;
     SetFiltCompression( ion);
     PDFCompressionOn := OnOff;
end;

function TQRPDFDocumentFilter.GetFilterName : string;
begin
  Result := 'PDF document';
end;

function TQRPDFDocumentFilter.GetDescription : string;
begin
  Result := SqrHTMLDocumentForWeb;
end;

function TQRPDFDocumentFilter.GetExtension : string;
begin
  Result := 'PDF'; // Do not translate
end;

function TQRPDFDocumentFilter.GetStreaming : boolean;
begin
  Result := false;
end;

procedure TQRPDFDocumentFilter.CreateStream(Filename : string);
begin
  if Filename = '' then
  begin
    FStream := TMemoryStream.Create;
    FreeStream := false;
  end else
  begin
    FreeStream := true;
    inherited CreateStream(Filename);
  end;
end;

procedure TQRPDFDocumentFilter.CloseStream;
begin
  if FreeStream then
    inherited CloseStream;
end;

destructor TQRPDFDocumentFilter.destroy;
begin
    Closedownlib;// move to 'finish'
    inherited;
end;

constructor TQRPDFDocumentFilter.Create( filename : string );
begin
   inherited Create( filename );
   InitLib( self.Owner );
   FBodyColor := clWhite;
   FFirstPage := true;
   FPageNumber := 1;
   FPageLength := 2500;
   FNextPicnum := 0;
   PDFConcatenating := false;
   FReportNum := 0;
   FLeftMargin := 0;
   FTopMargin := 0;
   PDFCompressionOn := false;
   FCharset := ANSI_CHARSET;
end;

procedure TQRPDFDocumentFilter.SetTextOnTop( bval : boolean );
begin
    settextfirst( not bval );
end;

procedure TQRPDFDocumentFilter.SetMargins( TopMarg, Leftmarg : integer );
begin
    FTopMargin := Topmarg;
    FLeftmargin := Leftmarg;
end;

// QBSS : override method
procedure TQRPDFDocumentFilter.ProcessPage;
begin
  FPageProcessed := True;
  StorePage;
end;

// Overridden Start
procedure TQRPDFDocumentFilter.Start(PaperWidth, PaperHeight : integer; Font : TFont);
var
    tm : extended;
begin
    if PDFConcatenating and (FReportnum > 0) then exit;
    inherited start( paperwidth, paperheight, Font );  // sets active true
    MMperpixelX := 1.0 / (10*TQuickrep(owner).QRPrinter.XFactor);
    MMperpixelY := 1.0 / (10*TQuickrep(owner).QRPrinter.YFactor);
    PointsPerPixelX := PointsPerMM  * MMperPixelX;
    PointsPerPixelY := PointsPerMM  * MMperPixelY;
    tm := TQuickrep(self.owner).page.TopMargin * 0.1 * PointsPerMM;
    SetPageParams( 0.1*PaperWidth*PointsPerMM, 0.1*paperheight*PointsPerMM, tm, FTopMargin, FLeftmargin );
    freportnum := 1;
end;

// overridden Finish
procedure TQRPDFDocumentFilter.Finish;
begin
    if PDFConcatenating then exit;
    // process the list of textitems and graphic items
    FinishDoc( filename );
    inherited;// sets active false
end;

procedure TQRPDFDocumentFilter.EndConcat;
begin
     PDFConcatenating := false;
     Finish;
end;

procedure TQRPDFDocumentFilter.StorePage;
begin
     // do nothing.
end;

// add a text titem to the list
procedure TQRPDFDocumentFilter.TextOut(X, Y : extended; Font : TFont; BGColor : TColor;
               Alignment : TAlignment; Text : string);
var
    xp, yp, textsize :integer;
    parentrep : TQuickrep;
    tmap : TBitmap;
begin
     tmap := TBitmap.Create;
   try
     // make a pdf textitem
     fpdfitem.ItemType := IT_TEXT;
     parentrep := tquickrep( self.owner );
     // text pos is in 1/10 mm
     // map the same as graphic elements
     xp := parentrep.QRPrinter.XPos( X );
     yp := parentrep.QRPrinter.YPos( Y );
     //Alignment - recalculate positions
     case alignment of
            taLeftJustify : ;// do nothing
            taRightJustify :
            begin
                // the xpos is the right of the text pos
                tmap.canvas.Font.Assign( font );
                textsize := tmap.canvas.textwidth( text );
                xp := xp - textsize;
            end;
            taCenter:
            begin
                // the xpos is the center of the text pos
                tmap.canvas.Font.Assign( font );
                textsize := tmap.canvas.textwidth( text );
                xp := xp - (textsize div 2);
            end;
     end;
     fpdfitem.Xpos := xp * PointsperpixelX;
     fpdfitem.Ypos := yp * PointsperpixelY + font.size;
     fpdfitem.FText := allocmem( length(text)+1);
     strpcopy(  fpdfitem.FText,Text );
     fpdfitem.Fontname := allocmem( length(Font.Name)+1);
     strpcopy(  fpdfitem.Fontname,Font.Name );
     fpdfitem.fontsize := Font.Size;
     if font.color < 0 then font.color := font.color and $00FFFFFF;
     fpdfitem.rgbfcolor.blue := getBvalue(font.color);
     fpdfitem.rgbfcolor.red := getRvalue(font.color);
     fpdfitem.rgbfcolor.green := getGvalue(font.color);
     fpdfitem.fbold := fsBold in font.Style;
     fpdfitem.fitalic := fsItalic in font.Style;
     AddPDFItem( fpdfitem );
   finally
      tmap.free;
   end;
end;

procedure TQRPDFDocumentFilter.AcceptGraphic( Xoff, Yoff : extended; GControl : TControl);
const
     REC_SIZE = 2048;
var
    xdim, ydim : longint;
    conwidth, conheight, coffset : integer;
    tempmap : TBitmap;
    SCont : TQRPDFShape;
    SSCont : TQRShape;
    qrdbcont : TQRDBImage;

    HCont : TQRHRule;
    drawpict : TPicture;
    aspectratio : double;
    dbcont : TQRGrDBImage;
    // this is the routine that takes all the time ...
    // compression and UTF85 filters must be applied here ...
    procedure CaptureImageBytes( srcmap : TBitmap; var imgstring:  string);
    var
        k, j : longint;
        b : byte;
        pcolor : TColor;
        imgstream, rlestream : TMemorystream;
        bbuff : array[0..3000] of byte;
        bp : integer;
        outbuff : string;
    begin
         xdim := srcmap.width;
         ydim := srcmap.height;
         outbuff := '';
         imgstream := TMemorystream.Create;
         rlestream := TMemorystream.Create;
         bp := 0;
         for j := 0 to ydim-1 do
         begin
             for k := 0 to xdim-1 do
             begin
                   pcolor := srcmap.Canvas.Pixels[ k, j ];
                   b := byte(pcolor);
                   bbuff[bp] := b;
                   inc(bp);
                   b := byte(pcolor shr 8);
                   bbuff[bp] := b;
                   inc(bp);
                   b := byte(pcolor shr 16);
                   bbuff[bp] := b;
                   inc(bp);
                   if bp >= 3000 then
                   begin
                       imgstream.WriteBuffer( bbuff, bp );
                       bp := 0;
                   end;
             end;

         end;
         if bp > 0 then
                imgstream.WriteBuffer( bbuff, bp );
         if CompressionOn then
         begin
           // apply RLE
           RunLength( imgstream, rlestream);
           // apply AsciiHex
           //AsciiHex( rlestream, imgfilename );
           AsciiHexToString( rlestream, imgstring );
         end
         else
           AsciiHexToString( imgstream, imgstring );
           //AsciiHex( imgstream, imgfilename );
         imgstream.Free;
         inc( FNextPicnum );
    end;
begin
  tempmap := TBitmap.create;
  drawpict := TPicture.Create;
  fpdfitem.xscale := 1.0;
  fpdfitem.yscale := 1.0;

  try
    if (GControl is TQRHRule) then
    begin
         HCont := (GControl as TQRHRule);
         fpdfitem.ItemType := IT_GRAPHIC;
         fpdfitem.shape := S_HLINE;
         fpdfitem.Xpos := Xoff * PointsPerpixelX;
         fpdfitem.Ypos := Yoff * PointsPerpixelY;
         fpdfitem.thickness := HCont.Pen.Width;
         if HCont.Pen.Color < 0 then HCont.Pen.Color := HCont.Pen.Color and $00FFFFFF;
         fpdfitem.rgbstrokecolor.red := getRvalue( HCont.Pen.Color);
         fpdfitem.rgbstrokecolor.green := getGvalue( HCont.Pen.Color);
         fpdfitem.rgbstrokecolor.blue := getBvalue( HCont.Pen.Color);
         fpdfitem.width := HCont.Width * PointsPerpixelX;
         fpdfitem.height := HCont.height * PointsPerpixelX;
         fpdfitem.filled := false;
         fpdfitem.Fontname := nil;
         fpdfitem.FText := nil;
         addpdfitem( fpdfitem );
         exit;
    end;
    if (GControl is TQRPDFShape) then
    begin
         SCont := (GControl as TQRPDFShape);
         fpdfitem.ItemType := IT_GRAPHIC;
         case scont.shapetype of
           qrsRectangle: fpdfitem.shape := S_BOX;
           qrsCircle: fpdfitem.shape := S_CIRCLE;
           qrsVertLine: fpdfitem.shape := S_VLINE;
           qrsHorLine: fpdfitem.shape := S_HLINE;
           qrsTopAndBottom: fpdfitem.shape := S_TOPBOTTOM;
           qrsRightAndLeft: fpdfitem.shape := S_LEFTRIGHT;
         end;
         fpdfitem.Xpos := Xoff * PointsPerpixelX;
         fpdfitem.Ypos := Yoff * PointsPerpixelY;
         fpdfitem.thickness := scont.Pen.Width;
         if scont.Pen.Color< 0 then scont.Pen.Color := scont.Pen.Color and $00FFFFFF;
         fpdfitem.rgbstrokecolor.red := getRvalue( scont.Pen.Color);
         fpdfitem.rgbstrokecolor.green := getGvalue( scont.Pen.Color);
         fpdfitem.rgbstrokecolor.blue := getBvalue( scont.Pen.Color);
         if scont.brush.Color< 0 then scont.brush.Color := scont.brush.Color and $00FFFFFF;
         fpdfitem.rgbfcolor.red := getRvalue( scont.brush.Color);
         fpdfitem.rgbfcolor.green := getGvalue( scont.brush.Color);
         fpdfitem.rgbfcolor.blue := getBvalue( scont.brush.Color);
         fpdfitem.width := SCont.Width * PointsPerpixelX;
         fpdfitem.height := SCont.height * PointsPerpixelX;
         fpdfitem.filled := bsClear <> scont.Brush.Style;
         fpdfitem.Fontname := nil;
         fpdfitem.FText := nil;
         addpdfitem( fpdfitem );
         exit;
    end;
    if (GControl is TQRShape) then
    begin
         SSCont := (GControl as TQRShape);
         fpdfitem.ItemType := IT_GRAPHIC;
         fpdfitem.shape := S_HLINE; // default ??
         case SSCont.Shape of
           qrsRectangle: fpdfitem.shape := S_BOX;