qrwebfilt.pas

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

        begin
              if cLinkType = ldHTTPJump then
                 atext := '<a href="' + aLinktext + '">' + aText + '</a>'
              else if cLinkType = ldNameJump then
                 atext := '<a href="#' + aLinktext + '">' + aText + '</a>'
              else
                 atext := '<a name="' + aLinktext + '">';
        end;
        // 12/10/01 try pixels ? map the same as graphic elements
        xp := parentrep.QRPrinter.XPos( X );
        yp := parentrep.QRPrinter.YPos( Y );
        // 08/10/01 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 );
                // must use 'originaltext' not 'atext' because we may have added html
                textsize := tmap.canvas.textwidth( originaltext );
                xp := xp - textsize;
            end;
            taCenter:
            begin
                // the xpos is the center of the text pos
                tmap.canvas.Font.Assign( font );
                // must use 'originaltext' not 'atext' because we may have added html
                textsize := tmap.canvas.textwidth( originaltext );
                xp := xp - (textsize div 2);
            end;
        end;
        // used to position links at page bottom
        pixely := yp; // to pixels
        if pixely > FPageMaxY then FPageMaxY := pixely;
        FixDivStr;

        Fontcolor := Font.Color;
        fBold := 'normal';
        fitalic := 'none';
        funderline := 'none';
        if HTMTransparentTextBG then
            fbgcolor := 'Transparent'
        else
            fbgcolor := 'white';
        if fsBold in Font.Style then
               fbold := 'Bold';
        if fsItalic in Font.Style then
               fitalic := 'Italic';
        if fsUnderline in Font.Style then
               funderline := 'Underline';
        if fsStrikeout in Font.Style then
               fstrike := 'Strikeout';
        if fitalic = 'Italic' then
          newdivstr := newdivstr + 'font-style:italic;';
        if fbold = 'Bold' then
          newdivstr := newdivstr + 'font-weight:bold;';
        if Fontcolor <> clBlack then
          newdivstr := newdivstr + 'color:'+trim(coltrans(fontcolor))+';';

        newdivstr := newdivstr + '">';
        writeToStream( newdivstr + chr($0D)+chr($0A));
        writeToStream( atext+ chr($0D)+chr($0A) );
        writeToStream('</DIV>'+ chr($0D)+chr($0A));
      finally
          tmap.free;
      end;
end;

// strip off file extension
function basename( fname : string ) : string;
var
   p : integer;
begin
    basename := fname;
    p := pos( '.', fname );
    if p = 0 then exit;
    basename := copy( fname, 1, p - 1 );
end;

procedure TQRGHTMLDocumentFilter.AcceptGraphic( Xoff, Yoff : extended; GControl : TControl);
var
    xpos, ypos, xdim, ydim, conwidth, conheight : integer;
    imgfile, divstr, FText : string;
    tempmap : TBitmap;
    SCont : TQRHRule;
    dbcont : TQRGrDBImage;
    SSCont : TQRShape;
    SPDFCont : TQRPDFShape;
    qrdbcont : TQRDBImage;
    gdest : TRect;
    aspectratio : double;
    drawpict : TPicture;
    jpeg : TJPEGImage;
begin
  tempmap := TBitmap.create;
  drawpict := TPicture.create;
  jpeg := TJPEGImage.create;
  try
    gdest.Left := trunc(Xoff);
    gdest.Top := round(Yoff);
    gdest.Right := gdest.left + GControl.Width;
    gdest.Bottom := gdest.top + GControl.height;
    conheight := GControl.height;
    conwidth := GControl.Width;
    if GControl is TQRHRule then
    begin
         SCont := (GControl as TQRHRule);
         //gdest.top := gdest.top - 8 - scont.VertAdjust;
         divstr := '<DIV style="position:absolute;left:'+
         format( '%-d', [gdest.left]) + 'px;top:' +
         format( '%-d', [gdest.top]) +
         format('px;height:%-dpx;"><hr width="', [ SCont.pen.width] ) +
         format( '%-d', [scont.width]) + '" size="' +
         format( '%-d', [SCont.pen.width]) + '" color="' +
         coltrans(scont.pen.color)+'"></div>';
         writeToStream( divstr + chr($0D)+chr($0A));
         if (gdest.top) > FPageMaxY then FPageMaxY := gdest.top;
         exit;
    end
    else if GControl is TQRShape then
    begin
         SSCont := (GControl as TQRShape);
         //gdest.top := gdest.top - 8 - sscont.VertAdjust;
         if SSCont.Shape = qrsHorLine then
         begin
            divstr := '<DIV style="position:absolute;left:'+ format( '%-d', [gdest.left]) +
            'px;top:' + format( '%-d', [gdest.top]) +
            format('px;height:%-dpx;"><hr width="', [ SSCont.pen.width] ) +
            format( '%-d', [sScont.width]) + '" size="' + format( '%-d', [SSCont.pen.width]) +
            '" color="' + coltrans(sscont.pen.color)+'"></div>';
            writeToStream( divstr + chr($0D)+chr($0A));
         end
         else if SSCont.Shape = qrsVertLine then
         begin
            divstr := '<DIV style="position:absolute;left:'+
            format( '%-d', [(gdest.left+gdest.right) div 2]) + 'px;top:' + format( '%-d', [gdest.top]) +
            format('px;height:%-dpx;width:', [ SSCont.height] ) +
            format( '%-d', [SSCont.pen.width]) + 'px; background-color: '
                   + coltrans(sscont.pen.color)+'"></div>';
            writeToStream( divstr + chr($0D)+chr($0A));
         end
         else if SSCont.Shape = qrsRectangle then
         begin
            if sscont.brush.style = bsSolid then
            begin
               divstr := '<DIV style="position:absolute;left:'+
               format( '%-d', [gdest.left]) + 'px;top:' + format( '%-d', [gdest.top]) +
               format('px;height:%-dpx;width:', [ SSCont.height] ) +
               format( '%-d', [SSCont.width]) + 'px; background-color: '
                   + coltrans(sscont.brush.color)+'"></div>';
               writeToStream( divstr + chr($0D)+chr($0A));
               exit;
            end;
            // groan we have to do 4 lines 2 h, 2 vert
            // vline left
            divstr := '<DIV style="position:absolute;left:'+
            format( '%-d', [gdest.left]) + 'px;top:' + format( '%-d', [gdest.top]) +
            format('px;height:%-dpx;width:', [ SSCont.height] ) +
            format( '%-d', [SSCont.pen.width]) + 'px; background-color: '
                   + coltrans(sscont.pen.color)+'"></div>';
            writeToStream( divstr + chr($0D)+chr($0A));
            // vline right
            divstr := '<DIV style="position:absolute;left:'+
            format( '%-d', [gdest.right-SSCont.pen.width]) + 'px;top:' + format( '%-d', [gdest.top]) +
            format('px;height:%-dpx;width:', [ SSCont.height] ) +
            format( '%-d', [SSCont.pen.width]) + 'px; background-color: '
                   + coltrans(sscont.pen.color)+'"></div>';
            writeToStream( divstr + chr($0D)+chr($0A));
            // pull up hlines
            gdest.top := gdest.top - 8 - sscont.VertAdjust;
            // hline upper
            divstr := '<DIV style="position:absolute;left:'+
            format( '%-d', [gdest.left]) + 'px;top:' + format( '%-d', [gdest.top]) +
            format('px;height:%-dpx;"><hr width="', [ SSCont.pen.width] ) +
            format( '%-d', [sScont.width]) + '" size="' +
            format( '%-d', [SSCont.pen.width]) + '" color="' +
            coltrans(sscont.pen.color)+'"></div>';
            writeToStream( divstr + chr($0D)+chr($0A));
            // hline lower
            divstr := '<DIV style="position:absolute;left:'+
            format( '%-d', [gdest.left]) + 'px;top:' +
            format( '%-d', [gdest.bottom-8]) +
            format('px;height:%-dpx;"><hr width="', [ SSCont.pen.width] ) +
            format( '%-d', [sScont.width]) + '" size="' +
            format( '%-d', [SSCont.pen.width]) + '" color="' +
            coltrans(sscont.pen.color)+'"></div>';
            writeToStream( divstr + chr($0D)+chr($0A));

         end;
         if (gdest.top) > FPageMaxY then FPageMaxY := gdest.top;
         exit;
    end
    else if GControl is TQRPDFShape then
    begin
         SPDFCont := (GControl as TQRPDFShape);
         //gdest.top := gdest.top - 8 - SPDFCont.VertAdjust;
         if SPDFCont.ShapeType = qrsHorLine then
         begin
            divstr := '<DIV style="position:absolute;left:'+ format( '%-d', [gdest.left]) +
            'px;top:' + format( '%-d', [gdest.top]) +
            format('px;height:%-dpx;"><hr width="', [ SPDFCont.pen.width] ) +
            format( '%-d', [SPDFCont.width]) + '" size="' + format( '%-d', [SPDFCont.pen.width]) +
            '" color="' + coltrans(SPDFCont.pen.color)+'"></div>';
            writeToStream( divstr + chr($0D)+chr($0A));
         end
         else if SPDFCont.ShapeType = qrsVertLine then
         begin
            divstr := '<DIV style="position:absolute;left:'+
            format( '%-d', [(gdest.left+gdest.right) div 2]) + 'px;top:' + format( '%-d', [gdest.top]) +
            format('px;height:%-dpx;width:', [ SPDFCont.height] ) +
            format( '%-d', [SPDFCont.pen.width]) + 'px; background-color: '
                   + coltrans(SPDFCont.pen.color)+'"></div>';
            writeToStream( divstr + chr($0D)+chr($0A));
         end
         else if SPDFCont.ShapeType = qrsRectangle then
         begin
            if SPDFCont.brush.style = bsSolid then
            begin
               divstr := '<DIV style="position:absolute;left:'+
               format( '%-d', [gdest.left]) + 'px;top:' + format( '%-d', [gdest.top]) +
               format('px;height:%-dpx;width:', [ SPDFCont.height] ) +
               format( '%-d', [SPDFCont.width]) + 'px; background-color: '
                   + coltrans(SPDFCont.brush.color)+'"></div>';
               writeToStream( divstr + chr($0D)+chr($0A));
               exit;
            end;
            // groan we have to do 4 lines 2 h, 2 vert
            // vline left
            divstr := '<DIV style="position:absolute;left:'+
            format( '%-d', [gdest.left]) + 'px;top:' + format( '%-d', [gdest.top]) +
            format('px;height:%-dpx;width:', [ SPDFCont.height] ) +
            format( '%-d', [SPDFCont.pen.width]) + 'px; background-color: '
                   + coltrans(SPDFCont.pen.color)+'"></div>';
            writeToStream( divstr + chr($0D)+chr($0A));
            // vline right
            divstr := '<DIV style="position:absolute;left:'+
            format( '%-d', [gdest.right-SPDFCont.pen.width]) + 'px;top:' + format( '%-d', [gdest.top]) +
            format('px;height:%-dpx;width:', [ SPDFCont.height] ) +
            format( '%-d', [SPDFCont.pen.width]) + 'px; background-color: '
                   + coltrans(SPDFCont.pen.color)+'"></div>';
            writeToStream( divstr + chr($0D)+chr($0A));
            // pull up hlines
            gdest.top := gdest.top - 8 - SPDFCont.VertAdjust;
            // hline upper
            divstr := '<DIV style="position:absolute;left:'+
            format( '%-d', [gdest.left]) + 'px;top:' + format( '%-d', [gdest.top]) +
            format('px;height:%-dpx;"><hr width="', [ SPDFCont.pen.width] ) +
            format( '%-d', [SPDFCont.width]) + '" size="' +
            format( '%-d', [SPDFCont.pen.width]) + '" color="' +
            coltrans(SPDFCont.pen.color)+'"></div>';
            writeToStream( divstr + chr($0D)+chr($0A));
            // hline lower
            divstr := '<DIV style="position:absolute;left:'+
            format( '%-d', [gdest.left]) + 'px;top:' +
            format( '%-d', [gdest.bottom-8]) +
            format('px;height:%-dpx;"><hr width="', [ SPDFCont.pen.width] ) +
            format( '%-d', [SPDFCont.width]) + '" size="' +
            format( '%-d', [SPDFCont.pen.width]) + '" color="' +
            coltrans(SPDFCont.pen.color)+'"></div>';
            writeToStream( divstr + chr($0D)+chr($0A));

         end;
         if (gdest.top) > FPageMaxY then FPageMaxY := gdest.top;
         exit;
    end
    else if GControl is TQRGrImage then
    begin
       tempmap.width := GDest.right-gdest.left;
       tempmap.height := gdest.bottom-gdest.top;
       imgfile := GControl.Name + '.jpg';
       if trim(picturedir) <> '' then
                 imgfile := IncludeTrailingPathDelimiter( HTMPictureDir ) + imgfile;
       if (GControl as TQRGrImage).Picture.Graphic is TBitmap then
       begin
            jpeg.Assign((GControl as TQRGrImage).Picture.bitmap);
            jpeg.savetofile(imgfile);
       end
       else
       begin
            tempmap.canvas.stretchdraw( Rect( 0, 0, tempmap.width, tempmap.height),
                                   (GControl as TQRGrImage).Picture.graphic);
            jpeg.Assign(tempmap);
            jpeg.savetofile(imgfile);
       end;
    end
    else if GControl is TQRImage then
    begin
       tempmap.width := GDest.right-gdest.left;
       tempmap.height := gdest.bottom-gdest.top;
       imgfile := GControl.Name + '.jpg';
       if trim(picturedir) <> '' then
                 imgfile := IncludeTrailingPathDelimiter( HTMPictureDir ) + imgfile;
       if (GControl as TQRImage).Picture.Graphic is TBitmap then
       begin
            jpeg.Assign((GControl as TQRImage).Picture.bitmap);
            jpeg.savetofile(imgfile);
       end
       else
       begin
            tempmap.canvas.stretchdraw( Rect( 0, 0, tempmap.width, tempmap.height),
                                   (GControl as TQRImage).Picture.graphic);
            jpeg.Assign(tempmap);
            jpeg.savetofile(imgfile);
       end;
    end
    else if (GControl is TQRDBImage) then
    begin
      qrdbcont := GControl as TQRDBImage;
      // proportional sizing
      drawpict.assign( qrdbcont.field );
      AspectRatio := 1.0 * drawpict.Width / drawpict.height;
      if not qrdbcont.stretch then
      begin
         if (drawpict.Width/conwidth) < (drawpict.Height/conHeight) then
               conHeight := trunc( conwidth / aspectratio )
         else
              conwidth := trunc( conheight * aspectratio );
      end;
      tempmap.width := conwidth;
      tempmap.height := conheight;

      inc( FNextPicnum );
      imgfile := GControl.Name + format( '%-d', [FNextPicnum] ) + '.jpg';
      if trim(picturedir) <> '' then
            imgfile := IncludeTrailingPathDelimiter( HTMPictureDir ) + imgfile;
      if qrdbcont.field <> nil then
      begin
            tempmap.assign( qrdbcont.field );
            jpeg.Assign(tempmap);
      end;
      jpeg.savetofile( imgfile );// blank pic for nil field
    end
    else if (GControl is TQRGrDBImage) then
    begin
      dbcont := GControl as TQRGrDBImage;
      // proportional sizing
      drawpict.assign( dbcont.field );
      AspectRatio := 1.0 * drawpict.Width / drawpict.height;
      if not dbcont.stretch then
      begin
       if dbcont.FitMode=fmProportional then
       begin
         if (drawpict.Width/conwidth) < (drawpict.Height/conHeight) then
               conHeight := trunc( conwidth / aspectratio )
         else
              conwidth := trunc( conheight * aspectratio );
       end
       else if dbcont.FitMode=fmKeepWidth then
               conHeight := trunc( conwidth / aspectratio )
       else if dbcont.FitMode=fmKeepHeight then
                conwidth := trunc( conheight * aspectratio );
      end;
      tempmap.width := conwidth;
      tempmap.height := conheight;

      inc( FNextPicnum );
      imgfile := GControl.Name + format( '%-d', [FNextPicnum] ) + '.jpg';
      if trim(picturedir) <> '' then
            imgfile := IncludeTrailingPathDelimiter( HTMPictureDir ) + imgfile;
      if (GControl as TQRGrDBImage).field <> nil then
      begin
            tempmap.assign( (GControl as TQRGrDBImage).field );
            jpeg.Assign(tempmap);
      end;
      jpeg.savetofile( imgfile );// blank pic for nil field
    end;
    FText := imgfile;
    XPos := GDest.left;
    YPos := GDest.top;
    XDim := conwidth;
    YDim := conheight;
    if (YPos+ydim) > FPageMaxY then FPageMaxY := (YPos+ydim);
    // graphic link : units pixels
    divstr := '<DIV style="position:absolute;left:'+
                       format( '%-d', [xpos]) +'px;top:'+
                       format( '%-d', [ypos]) +'px;">'+
                       '<img src="'+FText+'" width=' +
                       format( '%-d', [xdim])+' height=' +
                       format( '%-d', [ydim])+'></div>';
    writeToStream( divstr + chr($0D)+chr($0A));
  finally
    tempmap.free;
    drawpict.free;
    jpeg.free;
  end;
end;


end.