qrwebfilt.pas

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

  FPageProcessed := True;
end;

procedure TQRGAbstractExportFilter.StorePage;
begin
end;

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

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


{TQRGHTMLDocumentFilter}
function TQRGHTMLDocumentFilter.getTransparentTextBG : boolean;
begin
    result := HTMTransparentTextBG;
end;
procedure TQRGHTMLDocumentFilter.setTransparentTextBG( value : boolean);
begin
     HTMTransparentTextBG := value;
end;
function TQRGHTMLDocumentFilter.getPictureDir : string;
begin
    result := HTMPictureDir;
end;
procedure TQRGHTMLDocumentFilter.setPictureDir( value : string);
begin
    HTMPictureDir := value;
end;
function TQRGHTMLDocumentFilter.getMultiPage : boolean;
begin
    result := HTMMultiPage;
end;
procedure TQRGHTMLDocumentFilter.setMultiPage( value : boolean);
begin
     HTMMultiPage := value;
end;
function TQRGHTMLDocumentFilter.getFinalPage : integer;
begin
    result := HTMFinalPage;
end;
procedure TQRGHTMLDocumentFilter.setFinalPage( value : integer);
begin
     HTMFinalPage := value;
end;
function TQRGHTMLDocumentFilter.getFirstLastLinks :boolean;
begin
    result := HTMFirstLastLinks;
end;
procedure TQRGHTMLDocumentFilter.setFirstLastLinks( value : boolean);
begin
     HTMFirstLastLinks := value;
end;
function TQRGHTMLDocumentFilter.getPageLinks :boolean;
begin
    result := HTMPageLinks;
end;
procedure TQRGHTMLDocumentFilter.setPageLinks( value : boolean);
begin
     HTMPageLinks := value;
end;
function TQRGHTMLDocumentFilter.getConcatenate : boolean;
begin
    result := HTMConcatenate;
end;
procedure TQRGHTMLDocumentFilter.setConcatenate( value : boolean);
begin
     HTMConcatenate := value;
end;
function TQRGHTMLDocumentFilter.getConcatCount : integer;
begin
    result := HTMConcatCount;
end;
procedure TQRGHTMLDocumentFilter.setConcatCount( value : integer);
begin
     HTMConcatCount := value;
end;
procedure TQRGHTMLDocumentFilter.setLinkFontHeight( value : integer);
begin
     HTMLinkFontHeight := value;
end;
function TQRGHTMLDocumentFilter.getLinkFontHeight : integer;
begin
    result := HTMLinkFontHeight;
end;
function TQRGHTMLDocumentFilter.getLinkFontName : string;
begin
    result := HTMLinkFontName;
end;
procedure TQRGHTMLDocumentFilter.setLinkFontName( value : string);
begin
     HTMLinkFontName := value;
end;

function TQRGHTMLDocumentFilter.GetFilterName : string;
begin
  Result := SqrHtmlDocument;
end;

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

function TQRGHTMLDocumentFilter.GetExtension : string;
begin
  Result := 'HTM'; // Do not translate
end;

function TQRGHTMLDocumentFilter.GetStreaming : boolean;
begin
  Result := not MultiPage;// stream for 1 page report mode
end;

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

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

// QBS Upgraded HTML filter starts
constructor TQRGHTMLDocumentFilter.Create( filename : string );
begin
   inherited Create( Filename);
   FBackgroundpic := '';
   FBodyColor := clWhite;
   FExtraBody := '';
   HTMTransparentTextBG := false;
   HTMFirstPage := true;
   FFirstReport := true;
   HTMConcatenate := false;
   HTMMultiPage := false;
   HTMPageLinks := false;
   FPageNumber := 1;
   HTMLastPage := false;
   HTMFinalPage := 0;
   FPageLength := 2500;
   HTMPictureDir := '';
   FNextPicnum := 0;
   HTMLinkFontName := 'Arial';
   HTMLinkFontHeight := 12;
   FReportNumber := 1;
   HTMConcatCount := 1;

end;
// Give user access to new properties
procedure TQRGHTMLDocumentFilter.SetHTMLBody( BodyCol : TColor; BGPic, BExtra : string );
begin
    FBodyColor := BodyCol;
    FBackGroundPic := BGPic;
    FExtraBody := BExtra;
end;


// QBSS : override method to skip converttoxxx
procedure TQRGHTMLDocumentFilter.ProcessPage;
begin
  FPageProcessed := True;
  StorePage;
end;

function ColTrans( ct : TColor ) : string;
var
   tempstr : string;
begin
    if ct < 0 then
    begin
        result := '#000000';
        exit;
    end;
    tempstr := format ( '%6.6x', [longint(ct)]);
    result := '#' + copy( tempstr, 5, 2 ) +copy( tempstr, 3, 2 )  +copy( tempstr, 1, 2 ) ;
end;


// Overridden Start
procedure TQRGHTMLDocumentFilter.Start(PaperWidth, PaperHeight : integer; Font : TFont);
var
    propstr : string;
begin
  if not multipage then
  begin
    inherited;  // creates a stream
    propstr := ' bgcolor="'+coltrans( FBodycolor)+'" ';
    if trim(FBackgroundpic) <> '' then
          propstr := propstr + ' background="'+FBackgroundpic+'"';
    if trim(FExtraBody) <> '' then
          propstr := propstr + ' ' + FExtraBody;

    writetostream( '<html>' +chr($0D) + chr($0A) );
    writetostream( '<head>' +chr($0D) + chr($0A) );
    writetostream( ' <title>'+self.Filename+'</title>' +chr($0D) + chr($0A) );
    writetostream( '</head>' +chr($0D) + chr($0A)  );
    writetostream( '<body '+propstr+'>' +chr($0D) + chr($0A) );
  end;
end;

// overridden Finish
procedure TQRGHTMLDocumentFilter.Finish;
begin

  if not multipage then
  begin
    writetostream( '</body>' +chr($0D) + chr($0A) );
    writetostream( '</html>' +chr($0D) + chr($0A) );
  end;
  // inherited closes the stream. don't in Concat mode
  if not HTMConcatenate and not multipage then
      inherited finish
  else;
      Dec( FPagenumber);
  FFirstReport := false;
  inc(FReportNumber);
end;
procedure TQRGHTMLDocumentFilter.EndConcat;
begin
     HTMConcatenate := false;
     multipage := false;
     Finish;
end;


procedure TQRGHTMLDocumentFilter.EndPage;
var
     Linkstr, hfilename, hdr, prstr, nextstr : string;
     firststr, laststr : string;
begin
    if not MultiPage or HTMFirstPage then
    begin
        HTMFirstPage := false;
        exit;
    end;
    // put in links to other pages
    if pagelinks and multipage then
    begin
      hdr := '<div style="position:absolute;top:%-dpx;left:10mm;font-family:' + HTMlinkfontname +
                    ';font-size:%-dpt;'+ 'text-decoration:none;text-align:left;">';
      linkstr := format( hdr, [FPageMaxY + 30, HTMlinkfontheight] );
      prstr := '';
      nextstr := '';
      if not HTMLastPage then
      begin
          hfilename := basename(filename) + format( '%-d.html', [FPageNumber+1] );
          nextstr := '<a href="'+ LinkPrefix + hfilename +'">Next page</a>';
      end;
      if fpagenumber > 1 then
      begin // put in a back link
         hfilename := basename(filename) + format( '%-d.html', [FPageNumber-1] );
         prstr := '<a href="'+ LinkPrefix + hfilename +'">Previous page</a>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'
      end;
      if HTMFirstlastLinks then
      begin
          if (fpagenumber = 1) then // need to know last pageno
          begin
             hfilename := basename(filename) + format( '%-d.html', [HTMFinalPage] );
             laststr := '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<a href="'+ hfilename +'">Last page</a>';
          end;
          if HTMLastPage then
          begin
             hfilename := basename(filename) + format( '%-d.html', [1] );
             firststr := '<a href="'+ LinkPrefix + hfilename +'">First page</a>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;';
          end;
      end;
      linkstr := linkstr + firststr + prstr + nextstr + laststr + '<br><br></div>';
    end;
    writetostream( linkstr + chr($0D) + chr($0A) );
    writetostream( '</body>' +chr($0D) + chr($0A) );
    writetostream( '</html>' +chr($0D) + chr($0A) );
    inc(FPageNumber);
end;

// QBSS : override method to skip converttoxxx
procedure TQRGHTMLDocumentFilter.NewPage;
var
     hfilename, propstr : string;
begin
    if not HTMMultiPage then
    begin
        HTMFirstPage := false; // if it's not multipage do nowt
        exit;
    end;
    HTMFirstPage := false;
    closestream;
    FPageMaxY := 0; // can be any small value
    hfilename := basename(filename) + format( '%-d.html', [FPageNumber] );
    createstream( hfilename );
    propstr := ' bgcolor="'+coltrans( FBodycolor)+'" ';
    if trim(FBackgroundpic) <> '' then
          propstr := propstr + ' background="'+FBackgroundpic+'"';
    if trim(FExtraBody) <> '' then
          propstr := propstr + ' ' + FExtraBody;
    writetostream( '<html>' +chr($0D) + chr($0A) );
    writetostream( '<head>' +chr($0D) + chr($0A) );
    writetostream( ' <title>' + hfilename + '</title>' +chr($0D) + chr($0A) );
    writetostream( '</head>' +chr($0D) + chr($0A)  );
    writetostream( '<body '+propstr+'>' +chr($0D) + chr($0A) );
end;

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

// Using absolute positions we can output immediately
procedure TQRGHTMLDocumentFilter.TextOut(X, Y : extended; Font : TFont; BGColor : TColor;
               Alignment : TAlignment; Text : string);
//<DIV style="position:absolute;left:1px;top:184px;"><hr width="500" size="2" color="black"></div>
const
    // 12/10/01 top, left of <DIV now in pixels.
    DivStrDef = '<div style="position:absolute;top:!toppx;left:!leftpx;font-family:!fontname;'
                +'font-size:!fontsizept;';
                 //'color:!color;text-decoration:!deco;text-align:left;background-color:!bgcolor;'+
                 //'font-style:!style;font-weight :!weight;">';
var
  I, K, afontheight, xp, yp, pixely : integer;
  textsize : integer;
  Fontcolor : TColor;
  AText, afontname, fitalic, fbold, funderline, fstrike, fbgcolor : string;
  NewDivStr, aLinkText, originaltext : string;
  parentrep : TQuickrep;
  CBand : TQRCustomband;
  break2 : boolean;
  cLinkType : TLinkDef;
  tmap : TBitmap;

  procedure FixDivStr;
  begin
        newdivstr := stringreplace( newdivstr, '!top', format( '%-d', [yp] ), [rfReplaceAll] );
        newdivstr := stringreplace( newdivstr, '!left', format( '%-d', [xp] ), [rfReplaceAll] );
        newdivstr := stringreplace( newdivstr, '!fontname', trim(afontname), [rfReplaceAll] );
        newdivstr := stringreplace( newdivstr, '!fontsize', format( '%-d', [afontheight] ), [rfReplaceAll] );
  end;

begin
      tmap := TBitmap.create;
      try
        atext := Text;
        originaltext := Text;
        aLinktext := '';
        clinktype := ldHTTPJump; // keep compiler quiet !
        parentrep := TQuickrep( self.owner );
        if parentrep.DataSet <> nil then
              HTMLastPage := ( parentrep.DataSet.Eof and ( HTMConcatcount = FReportNumber ));
        break2 := false;
        for i := 0 to parentrep.ControlCount-1 do
        begin
             if  parentrep.Controls[i].InheritsFrom( TQRCustomBand ) then
             begin
                  CBand := TQRCustomBand(parentrep.Controls[i]);
                  for k := 0 to CBand.controlcount-1 do
                    if atext = '%!'+CBand.controls[k].name+'!%' then
                    begin
                          if (CBand.controls[k] is TQRHTMLLabel ) then
                          begin
                               aLinkText := TQRHTMLLabel( CBand.controls[k]).linktext;
                               aText := TQRHTMLLabel( CBand.controls[k]).caption;
                               originaltext := aText;
                               cLinkType := TQRHTMLLabel( CBand.controls[k]).LinkType;
                               break2 := true;
                               break;
                          end;
                    end;
                    if break2 then break;
             end;
        end;
        // must be a standard text or label control
        newdivstr := divstrdef;
        atext := stringreplace( atext, '&', '&amp;', [rfReplaceAll] );
        atext := stringreplace( atext, '<', '&lt;', [rfReplaceAll] );
        atext := stringreplace( atext, '>', '&gt;', [rfReplaceAll] );
        // 15/10/01 stuff spaces in text
        atext := stringreplace( atext, ' ', '&nbsp;', [rfReplaceAll] );
        afontname := Font.Name;
        aFontheight := Font.Size;
        if alinktext <> '' then