用服务器组件解决WEB交叉报表问题(2)

用服务器组件解决WEB交叉报表问题
——修改FastReport源码，支持内存流导出

 

Fast Report是一个经典的报表控件，不过其导出功能只支持导出到磁盘文件，而此项目为了避开权限的限制和出于服务器安全的需要，要求将Fast Report生成的报表导出到内存流，所以要修改Fast Report源码。{========================================================================
  DESIGN BY :  彭国辉
  DATE:        2007-09-15
  SITE:        http://kacarton.yeah.net/
  BLOG:        http://blog.csdn.net/nhconch
  EMAIL:       kacarton[A T]sohu.com  文章为作者原创，转载请注明文章出处、保留作者信息，谢谢支持！
=========================================================================}

Fast Report2.5的导出函数在FR_Class文件中声明，参考此函数，可以很轻易的写出导出到内存流的函数：
//添加导出到内存流的支持 --Conch 2007-09-10--
procedure TfrReport.ExportToStream(Filter: TfrExportFilter; Stream: TMemoryStream);
var
  s: String;
  Flag, NeedConnect: Boolean;
begin
  DocMode := dmPrinting;
  FCurrentFilter := Filter;
  if (Preview <> nil) and (EMFPages.Count = 0) then
  begin
    Preview.Disconnect;
    NeedConnect := True;
  end
  else
    NeedConnect := False;{========================================================================
  DESIGN BY :  彭国辉
  DATE:        2007-09-15
  SITE:        http://kacarton.yeah.net/
  BLOG:        http://blog.csdn.net/nhconch
  EMAIL:       kacarton[A T]sohu.com  文章为作者原创，转载请注明文章出处、保留作者信息，谢谢支持！
=========================================================================}

  Flag := True;
  if Assigned(FCurrentFilter.OnBeforeExport) then
    FCurrentFilter.OnBeforeExport(FCurrentFilter.FileName, Flag);
    FCurrentFilter.Stream := Stream;

      CurReport := Self;
      MasterReport := Self;
      SavedAllPages := EMFPages.Count;

      FCurrentFilter.OnBeginDoc;
        ExportBeforeModal(Self);

    if Assigned(FCurrentFilter.OnAfterExport) then
      FCurrentFilter.OnAfterExport(FCurrentFilter.FileName);

  if NeedConnect then
    Preview.Connect(Self);
  FCurrentFilter := nil;
end;

同样，TfrHTML2Export控件是将CSS文件与HTML分开保存的，这样使得内存流中的HTML内容因缺少CSS而无法显示，故此要修改TfrHTML2Export.OnEndDoc函数。从该函数中找到SaveStringToFile(ImageFolderFull + '/' + CSSFile, s)这一句（FR2.5在第461行），改为：
    if FileName <> '' then
      SaveStringToFile(ImageFolderFull + '/' + CSSFile, s)
    else begin
      s := '<style type=''text/css''>' + LF + s + LF + '</style>' + LF;
      Stream.Write(s[1], Length(s));
    end;{========================================================================
  DESIGN BY :  彭国辉
  DATE:        2007-09-15
  SITE:        http://kacarton.yeah.net/
  BLOG:        http://blog.csdn.net/nhconch
  EMAIL:       kacarton[A T]sohu.com  文章为作者原创，转载请注明文章出处、保留作者信息，谢谢支持！
=========================================================================}
其它版本或其它导出控件可按此方法修改（导出Excel控件因使用OLE技术调用Excel组件，只能保存到磁盘文件），修改后的OnEndDoc函数如下：
procedure TfrHTML2Export.OnEndDoc;
var
  s             : string;
  i, j          : integer;
  Page          : THPage;
  LastBottom    : integer;
  CSSFile       : string;
  CSSFilePrint  : string;
  NavFile       : string;
//  DefaultStyle : THStyle;
//  Style        : THStyle;
  h1, h2        : string;
  MaxWidth      : integer;
  MinLeftMargin : integer;

begin
  if Navigator = nil then Exit;
  if FPages.Count = 0 then Exit;

  if FStyles.Count > 0 then
  begin
    s := '';
    CSSFilePrint := ChangeFileExt(ExtractFileName(FileName), '_print.css');

    if Navigator.Position <> [] then
      s := s + Navigator.GetStyleHTML(true);

    if s <> '' then
      SaveStringToFile(ImageFolderFull + '/' + CSSFilePrint, s);
    {----------------------------}

    CSSFile := ChangeFileExt(ExtractFileName(FileName), '.css');

    {DefaultStyle := nil;
    for i := 0 to FStyles.Count - 1 do
    begin
      Style := THStyle(FStyles[i]);
      if not (Style is THStyleFrame) or
        (THStyleFrame(Style).FFillColor = $1FFFFFFF) then
        if (DefaultStyle = nil) or (Style.FCount > DefaultStyle.FCount) then
          DefaultStyle := THStyle(FStyles[i]);
    end;

    if DefaultStyle <> nil then
      DefaultStyle.SetDefault;}

    //s := 'img' + LF + '{' + LF + 'border: 0px solid #000000;' + LF + '}' + LF;

    s := 'span' + LF + '{' + LF + 'position: absolute;' + LF + '}' + LF +
      'img' + LF + '{' + LF + 'position: absolute;' + LF + '}' + LF +
      '.page_break' + LF + '{' + LF + 'page-break-before: always;' + LF + '}' + LF;

    for i := 0 to FStyles.Count - 1 do
      s := s + THStyle(FStyles[i]).GetHtml + LF;

    if {(FPages.Count > 1) and} (Navigator.Position <> []) then
      s := s + Navigator.GetStyleHTML(false);
    //配合导出到内存流功能，将CSS内容直接写到流中 --Conch--
    if FileName <> '' then
      SaveStringToFile(ImageFolderFull + '/' + CSSFile, s)
    else begin
      s := '<style type=''text/css''>' + LF + s + LF + '</style>' + LF;
      Stream.Write(s[1], Length(s));
    end;
    {----------------------------}
  end;

  if FMultiPage and (FNavigator.Position <> []) then
  begin
    if Navigator.InFrame and Navigator.WideInFrame then
    begin
      MaxWidth := Screen.Width - 20;
      MinLeftMargin := 0;
    end
    else begin
      MaxWidth := 0;
      MinLeftMargin := High(integer);
      for j := 0 to FPages.Count - 1 do
      begin
        Page := THPage(FPages[j]);
        if Page.Width - Page.RightMargin > MaxWidth then
          MaxWidth := Page.Width - Page.RightMargin;
        if Page.LeftMargin < MinLeftMargin then
          MinLeftMargin := Page.LeftMargin;
      end;
      if MaxWidth + MinLeftMargin > Screen.Width then
        MaxWidth := Screen.Width - MinLeftMargin;
    end;

    FNavigator.BuildItems(MaxWidth);

    if FNavigator.InFrame then
    begin
      NavFile := ChangeFileExt(ExtractFileName(FileName), '') + '_' +
        NavigatorFilePostfix + '_0.html';
      if npTop in Navigator.Position then
        h1 := Format('%dpx,', [Navigator.GetHeight])
      else
        h1 := '';

      if npBottom in Navigator.Position then
        h2 := Format(', %dpx', [Navigator.GetHeight])
      else
        h2 := '';

      s := Format(HTMLHeader, [CurReport.Title, CSSFile, CSSFilePrint]) +
        Format('<frameset rows="%s *%s" framespacing="0" frameborder="0" border="0">',
          [h1, h2]) + LF;

      if npTop in Navigator.FPosition then
        s := s + Format('<frame src="%s" name="NAVIGATOR_TOP" scrolling="no" ' +
          'marginwidth="0" marginheight="0">', [ImageFolder + '/' + NavFile]) + LF;

      s := s + Format('<frame src="%s" name="%s" scrolling="yes" marginwidth="0" ' +
        'marginheight="0">', [ImageFolder + '/' + THPage(FPages[0]).GetName,
        PageFrame]) + LF;

      if npBottom in Navigator.FPosition then
        s := s + Format('<frame src="%s" name="NAVIGATOR_BOTTOM" scrolling="no" ' +
          'marginwidth="0" marginheight="0">', [ImageFolder + '/' + NavFile]) + LF;

      s := s + '</frameset>' + LF + HTMLFooter;
      Stream.Write(s[1], Length(s));

      for j := 0 to FNavigator.FItems.Count - 1 do
      begin
        s := Format(HTMLHeader, [CurReport.Title, CSSFile, CSSFilePrint]);
        s := s + Navigator.GetHTML(TNavigatorItem(FNavigator.FItems[j]).MinPage,
          0, MinLeftMargin, MaxWidth, true) + HTMLFooter;
        NavFile := ChangeFileExt(ExtractFileName(FileName), '') + '_' +
          NavigatorFilePostfix + '_' + IntToStr(j) + '.html';
        SaveStringToFile(ImageFolderFull + '/' + NavFile, s);
      end;
    end;
  end;

  LastBottom := 5;
  for j := 0 to FPages.Count - 1 do
  begin
    Page := THPage(FPages[j]);

    if FMultiPage then
    begin
      if (j = 0) and (not Navigator.InFrame or (Navigator.Position = [])) then
        s := Format(HTMLHeader, [CurReport.Title, ImageFolder + '/' + CSSFile,
          ImageFolder + '/' + CSSFilePrint])
      else
        s := Format(HTMLHeader, [CurReport.Title, CSSFile, CSSFilePrint]);

      LastBottom := 5;
      if (FNavigator.Position <> []) and FNavigator.InFrame then
      begin
        s := s + Page.GetHTML(LastBottom, 0) + HTMLFooter;  //!!!!!!!!!!!!!!!!!!!!
        SaveStringToFile(ImageFolderFull + '/' + Page.GetName, s);
      end
      else begin
        if (FPages.Count > 1) and (npTop in Navigator.Position) then
        begin
          s := s + Navigator.GetHTML(Page.ID, LastBottom, Page.LeftMargin,
            Page.Width - Page.RightMargin, false);
          Inc(LastBottom, Navigator.GetHeight + 15);
        end;

        s := s + Page.GetHTML(LastBottom, 0);

        if (FPages.Count > 1) and (npBottom in Navigator.Position) then
          s := s + Navigator.GetHTML(Page.ID, Page.Height + LastBottom +
            {Page.BottomMargin} + 5, Page.LeftMargin, Page.Width - Page.RightMargin, false);

        s := s + HTMLFooter;

        if j = 0 then
          Stream.Write(s[1], Length(s))
        else
          SaveStringToFile(ImageFolderFull + '/' + Page.GetName, s);
      end;
    end
    else begin
      s := Page.GetHTML(LastBottom, 0);
      if j = 0 then
        s := Format(HTMLHeader, [CurReport.Title, ImageFolder + '/' + CSSFile,
          ImageFolder + '/' + CSSFilePrint]) + s;
      Stream.Write(s[1], Length(s));
      Inc(LastBottom, Page.Height);
    end;
  end;

  if not FMultiPage then
  begin
    s := HTMLFooter;
    Stream.Write(s[1], Length(s));
  end;

  ClearListWithFree(FNavigator.FItems);
  ClearListWithFree(FStyles);
  ClearListWithFree(FPages);
end;{========================================================================
  DESIGN BY :  彭国辉
  DATE:        2007-09-15
  SITE:        http://kacarton.yeah.net/
  BLOG:        http://blog.csdn.net/nhconch
  EMAIL:       kacarton[A T]sohu.com  文章为作者原创，转载请注明文章出处、保留作者信息，谢谢支持！
=========================================================================}

经修改后就可以直接用FrReport1.ExportToStream(ex{TfrHTML2Export}, Stream{TMemoryStream});将报表导出到内存流了。

上一篇：用服务器组件解决WEB交叉报表问题(1)