frxexporthtml.pas

这个是功能强大的报表软件

        else
          WriteExpLn(' border-right-width: 0px;');
        if (ftTop in EStyle.FrameTyp) then
          WriteExpLn(' border-top-width: ' + su + ';')
        else
          WriteExpLn(' border-top-width: 0px;');
        if (ftBottom in EStyle.FrameTyp) then
          WriteExpLn(' border-bottom-width: ' + su + ';')
        else
          WriteExpLn(' border-bottom-width: 0px;');
      end;
      WriteExpLn(' text-align: ' + Horiz + '; vertical-align: ' + Vert +';');
      WriteExpLn('}');
    end;
    WriteExpLn('--></style>');
  end;
  WriteExpLn('</head>');
  WriteExpLn('<body');
  if FBackImageExist and FExportPictures then
  begin
    if FUseJpeg then
    begin
      s := GetPicsFolder + 'backgrnd.jpg';
      s1 := ExtractFilePath(s);
      if (s1 = ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(FileName)), '.files\')) or (s1 = '') then
         s := ExtractFilePath(filename) + s;
      jpg := TJPEGImage.Create;
      jpg.Assign(FBackImage);
      jpg.SaveToFile(s);
      Files.Add(s);
      jpg.Free;
      s := ReverseSlash(GetPicsFolderRel + 'backgrnd.jpg');
    end else
    if FUseGif then
    begin
      s := GetPicsFolder + 'backgrnd.gif';
      s1 := ExtractFilePath(s);
      if (s1 = ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(FileName)), '.files\')) or (s1 = '') then
         s := ExtractFilePath(filename) + s;
      GIFSaveToFile(s, FBackImage);
      Files.Add(s);
      s := ReverseSlash(GetPicsFolderRel + 'backgrnd.gif');
    end else
    begin
      s := GetPicsFolder + 'backgrnd.bmp';
      if (ExtractFilePath(s) = ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(FileName)), '.files\')) or
         (ExtractFilePath(s) = '') then
         s := ExtractFilePath(filename) + s;
      FBackImage.SaveToFile(s);
      Files.Add(s);
      s := ReverseSlash(GetPicsFolderRel + 'backgrnd.bmp');
    end;
    WriteExpLn(' background="' + s + '"');
  end;
  WriteExpLn(' bgcolor="#FFFFFF" text="#000000">');
  WriteExpLn(FHTMLDocumentBody.Text);
  WriteExpLn('<a name="PageN1"></a>');
  if FFixedWidth then
    st := ' width="' + IntToStr(Round((FMatrix.MaxWidth - FMatrix.Left) / Xdivider)) + '"'
  else
    st := '';
  if FCentered then
    st := st + ' align="center"';
  tableheader := '<table' + st +' border="0" cellspacing="0" cellpadding="0"';
  WriteExpLn(tableheader + '>');

  columnWidths := '<tr style="height: 1px">';
  for x := 0 to FMatrix.Width - 2 do
  begin
    dcol := Round((FMatrix.GetXPosById(x + 1) - FMatrix.GetXPosById(x)) / Xdivider);
    columnWidths := columnWidths + '<td width="' + IntToStr(dcol) + '"/>';
  end;
  if FMatrix.Width < 2 then
    columnWidths := columnWidths + '<td/>';
  columnWidths := columnWidths + '</tr>';
  WriteExpLn(columnWidths);

  pbk := 0;
  st := '';
  newpage := False;

  for y := 0 to FMatrix.Height - 2 do
  begin
    if ShowProgress and (not FMultipage) then
      if FProgress.Terminated then
        break;
    drow := Round((FMatrix.GetYPosById(y + 1) - FMatrix.GetYPosById(y)) / Ydivider);
    s := '';
    if FMatrix.PagesCount > pbk then
      if Round(FMatrix.GetPageBreak(pbk)) <= Round(FMatrix.GetYPosById(y + 1)) then
      begin
        Inc(pbk);
        if ShowProgress and (not FMultipage) then
          FProgress.Tick;
        newpage := True;
      end;
    if drow = 0 then
      drow := 1;
    WriteExpLn('<tr style="height:' + IntToStr(drow) + 'px">');
    buff := '';
    for x := 0 to FMatrix.Width - 2 do
    begin
      if ShowProgress and (not FMultipage) then
        if FProgress.Terminated then
          break;
      i := FMatrix.GetCell(x, y);
      if (i <> -1) then
      begin
        Obj := FMatrix.GetObjectById(i);
        if Obj.Counter = 0 then
        begin
          FMatrix.GetObjectPos(i, fx, fy, dx, dy);
          Obj.Counter := 1;
          
          if dx > 1 then
            s := ' colspan="' + IntToStr(dx) + '"'
          else
            s := '';
          if dy > 1 then
            sb := ' rowspan="' + IntToStr(dy) + '"'
          else
            sb := '';
          if FExportStyles then
            st := ' class="' + 's' + IntToStr(Obj.StyleIndex) + '"'
          else
            st := '';
          if Length(Trim(Obj.Memo.Text)) = 0 then
            st := st + ' style="font-size:1px"';

          buff := buff + '<td' + s + sb + st + '>';

          if Length(Obj.URL) > 0 then
          begin
            if Obj.URL[1] = '@' then
              if  FMultipage then
              begin
                Obj.URL := StringReplace(Obj.URL, '@', '', []);
                Obj.URL := ReverseSlash(GetPicsFolderRel + Trim(Obj.URL) + '.html')
              end
              else
                Obj.URL := StringReplace(Obj.URL, '@', '#PageN', []);
            buff := buff + '<a href="' + Obj.URL + '">';
            hlink := True;
          end
          else
            hlink := False;

          if Obj.IsText then
          begin
{$IFDEF Delphi12}
            text := Trim(ChangeReturns(TruncReturns(Obj.Memo.Text)));
{$ELSE}
            text := Trim(ChangeReturns(UTF8Encode(TruncReturns(Obj.Memo.Text))));
{$ENDIF}
            if Length(text) > 0 then
              buff := buff + text
            else
              buff := buff + '&nbsp;';
          end else
          if Obj.Image <> nil then
          begin
            if FUseJpeg then
            begin
              s := GetPicsFolder + 'img' + IntToStr(FPicturesCount) + '.jpg';
              s1 := ExtractFilePath(s);
              if (s1 = ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(FileName)), '.files\')) or (s1 = '') then
                s := ExtractFilePath(filename) + s;
              jpg := TJPEGImage.Create;
              jpg.Assign(Obj.Image);
              jpg.SaveToFile(s);
              Files.Add(s);
              jpg.Free;
              s := ReverseSlash(GetPicsFolderRel + 'img' + IntToStr(FPicturesCount) + '.jpg');
            end else
            if FUseGif then
            begin
              s := GetPicsFolder + 'img' + IntToStr(FPicturesCount) + '.gif';
              s1 := ExtractFilePath(s);
              if (s1 = ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(FileName)), '.files\')) or (s1 = '') then
                s := ExtractFilePath(filename) + s;
              GIFSaveToFile(s, Obj.Image);
              Files.Add(s);
              s := ReverseSlash(GetPicsFolderRel + 'img' + IntToStr(FPicturesCount) + '.gif');
            end else
            begin
              s := GetPicsFolder + 'img' + IntToStr(FPicturesCount) + '.bmp';
              s1 := ExtractFilePath(s);
              if (s1 = ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(FileName)), '.files\')) or
                 (s1 = '') then
                s := ExtractFilePath(filename) + s;
              Obj.Image.SaveToFile(s);
              Files.Add(s);
              s := ReverseSlash(GetPicsFolderRel + 'img' + IntToStr(FPicturesCount) + '.bmp');
            end;
            buff := buff + '<img src="' + s + '" width="' + IntToStr(Obj.Image.Width) +
                           '" height="' + IntToStr(Obj.Image.Height) + '" alt="">';
            Inc(FPicturesCount);
          end;
          if hlink then
            buff := buff + '</a>';
          buff := buff + '</td>';
        end;
      end
      else
        buff := buff + '<td/>';
    end;
    WriteExpLn(buff);
    WriteExpLn('</tr>');
    if newpage then
    begin
      WriteExpLn('</table>');
      newpage := False;
      if y < FMatrix.Height - 2 then
      begin
        WriteExpLn('<a name="PageN' + IntToStr(pbk + 1) + '"></a>');
        WriteExpLn(tableheader + ' class="page_break">');
        WriteExpLn(columnWidths);
      end;
    end;
  end;
  if FMultipage or (FMatrix.Height < 2) then
    WriteExpLn('</table>');
  WriteExpLn(FHTMLDocumentEnd.Text);
end;

function TfrxHTMLExport.ShowModal: TModalResult;
begin
  if not Assigned(Stream) then
  begin
    with TfrxHTMLExportDialog.Create(nil) do
    begin
      SendMessage(GetWindow(PFormatCB.Handle,GW_CHILD), EM_SETREADONLY, 1, 0);
      OpenAfterCB.Visible := not SlaveExport;
      MultipageCB.Enabled := not SlaveExport;
      BackgrCB.Enabled := not SlaveExport;
      NavigatorCB.Enabled := not SlaveExport;
      PicsSameCB.Enabled := not SlaveExport;
      if OverwritePrompt then
        SaveDialog1.Options := SaveDialog1.Options + [ofOverwritePrompt];

      if SlaveExport then
      begin
        FOpenAfterExport := False;
        FExportPictures := True;
        FPicsInSameFolder := True;
        FNavigator := False;
        FMultipage := False;
        FBackground := False;
      end;

      if (FileName = '') and (not SlaveExport) then
        SaveDialog1.FileName := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), SaveDialog1.DefaultExt)
      else
        SaveDialog1.FileName := FileName;

      StylesCB.Checked := FExportStyles;
      PicsSameCB.Checked := FPicsInSameFolder;
      if not FExportPictures then
        PFormatCB.ItemIndex := 0
      else
      begin
        if FUseJpeg then
          PFormatCB.ItemIndex := 1
        else if FUseGif then
          PFormatCB.ItemIndex := 3
        else
          PFormatCB.ItemIndex := 2
      end;
      OpenAfterCB.Checked := FOpenAfterExport;
      FixWidthCB.Checked := FFixedWidth;
      NavigatorCB.Checked := FNavigator;
      MultipageCB.Checked := FMultipage;
      BackgrCB.Checked := FBackground;

      if PageNumbers <> '' then
      begin
        PageNumbersE.Text := PageNumbers;
        PageNumbersRB.Checked := True;
      end;

      Result := ShowModal;
      if Result = mrOk then
      begin
        PageNumbers := '';
        CurPage := False;
        if CurPageRB.Checked then
          CurPage := True
        else if PageNumbersRB.Checked then
          PageNumbers := PageNumbersE.Text;

        FExportStyles := StylesCB.Checked;
        FPicsInSameFolder := PicsSameCB.Checked;
        FExportPictures := not (PFormatCB.ItemIndex = 0);
        FUseJpeg := PFormatCB.ItemIndex = 1;
        FUseGif := PFormatCB.ItemIndex = 3;
        FOpenAfterExport := OpenAfterCB.Checked;
        FFixedWidth := FixWidthCB.Checked;
        FMultipage := MultipageCB.Checked;
        FNavigator := NavigatorCB.Checked;
        FBackground := BackgrCB.Checked;

        if not SlaveExport then
        begin
          if DefaultPath <> '' then
            SaveDialog1.InitialDir := DefaultPath;
          if SaveDialog1.Execute then
            FileName := SaveDialog1.FileName
          else
            Result := mrCancel;
        end;
      end;
      Free;
    end
  end else
    Result := mrOk;
end;

function TfrxHTMLExport.Start: Boolean;
begin
  if SlaveExport then
  begin
    FOpenAfterExport := False;
    FExportPictures := True;
    FPicsInSameFolder := True;
    FNavigator := False;
    FMultipage := False;
    FBackground := False;
    if Report.FileName <> '' then
      FileName := ChangeFileExt(GetTemporaryFolder + ExtractFileName(Report.FileName), frxGet(8211))
    else
      FileName := ChangeFileExt(GetTempFile, frxGet(8211));
  end;
  if (FileName <> '') or Assigned(Stream) then
  begin
    if (ExtractFilePath(FileName) = '') and (DefaultPath <> '') then
      FileName := DefaultPath + '\' + FileName;
    FCurrentPage := 0;
    FPicturesCount := 0;
    FMatrix := TfrxIEMatrix.Create(UseFileCache, Report.EngineOptions.TempDir);
    FMatrix.Report := Report;
    if not FMultipage then
      FMatrix.ShowProgress := ShowProgress
    else
      FMatrix.ShowProgress := False;
    FMatrix.Inaccuracy := 0.5;
    FMatrix.RotatedAsImage := True;
    FMatrix.FramesOptimization := True;
    FMatrix.Background := FBackground;
    FMatrix.BackgroundImage := False;
    FMatrix.Printable := ExportNotPrintable;
    FMatrix.RichText := True;
    FMatrix.PlainRich := True;
    FMatrix.EmptyLines := EmptyLines;
    if Assigned(Stream) then
    begin
      FMultipage := False;
      FExportPictures := False;
      FNavigator := False;
    end;
    Result := True
  end
  else
    Result := False;
  Files.Clear;
end;

procedure TfrxHTMLExport.StartPage(Page: TfrxReportPage; Index: Integer);
begin
  Inc(FCurrentPage);
  FBackImageExist := False;
  FBackImage.Width := 0;
  FBackImage.Height := 0;
end;

procedure TfrxHTMLExport.ExportObject(Obj: TfrxComponent);
begin
  if (Obj is TfrxView) and (ExportNotPrintable or TfrxView(Obj).Printable) then
  begin
    if (Obj is TfrxCustomMemoView) or (Obj is TfrxLineView) or
      (FExportPictures and (not (Obj is TfrxCustomMemoView))) then
      FMatrix.AddObject(TfrxView(Obj));
    if (TfrxView(Obj).Name = '_pagebackground') and FExportPictures and FBackground then
    begin
      FBackImageExist := True;
      FBackImage.Width := Round(TfrxView(Obj).Width);
      FBackImage.Height := Round(TfrxView(Obj).Height);
      TfrxView(Obj).Draw(FBackImage.Canvas ,1, 1, -TfrxView(Obj).AbsLeft, -TfrxView(Obj).AbsTop);
    end;
  end;
end;

procedure TfrxHTMLExport.FinishPage(Page: TfrxReportPage; Index: Integer);
var