frxexportodf.pas

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

                        end
                        else
                          s2 := s;
{$IFDEF Delphi12}
                        s := s2;
{$ELSE}
                        s := UTF8Encode(s2);
{$ENDIF}


// added to
                        Prop['office:value'] := s;
                        with Add do
                        begin
                          Name := 'text:p';
                          if FExportType = 'text' then
                            Prop['text:style-name'] := 'p' + IntToStr(Obj.StyleIndex);
                          Value := s;
                        end;
                      end
                      else
                      // picture
                      if (Obj.Image <> nil) or (Obj.Metafile.Width > 0) then
                      begin
                        Inc(PicCount);
                        with Add do
                        begin
                          if FExportEMF then
                          begin
                            s := 'pic' + IntToStr(PicCount) + '.emf';
                            Obj.Metafile.SaveToFile(FTempFolder + 'Pictures\' + s);
                          end
                          else
                          begin
                            s := 'pic' + IntToStr(PicCount) + '.bmp';
                            Obj.Image.SaveToFile(FTempFolder + 'Pictures\' + s);
                          end;
                          Name := 'draw:frame';
                          Prop['draw:z-index'] := '0';
                          Prop['draw:name'] := 'Picture' + IntToStr(PicCount);
                          Prop['draw:style-name'] := 'gr1';
                          Prop['draw:text-style-name'] := 'P1';
                          Prop['svg:width'] := frFloat2Str(Obj.Width / odfDivider, 3) + 'cm';
                          Prop['svg:height'] := frFloat2Str(Obj.Height / odfDivider, 3) + 'cm';
                          Prop['svg:x'] := '0cm';
                          Prop['svg:y'] := '0cm';
                          with Add do
                          begin
                            Name := 'draw:image';
                            Prop['xlink:href'] := 'Pictures/' + s;
                            Prop['xlink:type'] := 'simple';
                            Prop['xlink:show'] := 'embed';
                            Prop['xlink:actuate'] := 'onLoad';
                          end;
                        end;
                      end;
                    end
                    else
                    begin
                      Name := 'table:covered-table-cell';
                      Prop['table:style-name'] := 'ceb';
                      if FExportType = 'text' then
                      begin
                        with Add do
                        begin
                          Name := 'text:p';
                          if FExportType = 'text' then
                            Prop['text:style-name'] := 'pb';
                        end;
                      end;
                    end;
                  end
                  else
                  begin
                    Name := 'table:table-cell';
                    if FExportType = 'text' then
                    begin
                      with Add do
                      begin
                        Name := 'text:p';
                        if FExportType = 'text' then
                          Prop['text:style-name'] := 'pb';
                      end;
                    end;
                  end;
                end;
              end;
            end;
          end;
        end;
      end;
    end;
    XML.SaveToFile(FTempFolder + 'content.xml');
  finally
    XML.Free;
  end;
  MkDir(FTempFolder + 'META-INF');
  s := FExportType;
  OdfCreateManifest(FTempFolder + 'META-INF\manifest.xml', PicCount, s);
  OdfCreateMime(FTempFolder + 'mimetype', s);
  OdfCreateMeta(FTempFolder + 'meta.xml', Creator);
  FZipFile := TfrxZipArchive.Create;
  try
    FZipFile.RootFolder := AnsiString(FTempFolder);
    FZipFile.AddDir(AnsiString(FTempFolder));
    if ShowProgress then
    begin
      FProgress.Execute(FZipFile.FileCount, frxResources.Get('ProgressWait'), True, True);
      FZipFile.OnProgress := DoOnProgress;
    end;
    FZipFile.SaveToStream(Stream);
  finally
    FZipFile.Free;
  end;
  DeleteFolder(FTempFolder);
end;

function TfrxODFExport.ShowModal: TModalResult;
begin
  if not Assigned(Stream) then
  begin
    with TfrxODFExportDialog.Create(nil) do
    begin
      SaveDialog1.DefaultExt := DefaultExt;
      SaveDialog1.Filter := FilterDesc;
      Caption := ExportTitle; 
      OpenCB.Visible := not SlaveExport;
      if OverwritePrompt then
        SaveDialog1.Options := SaveDialog1.Options + [ofOverwritePrompt];
      if SlaveExport then
        FOpenAfterExport := False;

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

      ContinuousCB.Checked := (not EmptyLines) or SuppressPageHeadersFooters;
      PageBreaksCB.Checked := FExportPageBreaks and (not ContinuousCB.Checked);
      WCB.Checked := FWysiwyg;
      OpenCB.Checked := FOpenAfterExport;
      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;

        FExportPageBreaks := PageBreaksCB.Checked and (not ContinuousCB.Checked);
        EmptyLines := not ContinuousCB.Checked;
        SuppressPageHeadersFooters := ContinuousCB.Checked;
        FWysiwyg := WCB.Checked;
        FOpenAfterExport := OpenCB.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 TfrxODFExport.Start: Boolean;
begin
  if SlaveExport then
  begin
    if Report.FileName <> '' then
      FileName := ChangeFileExt(GetTemporaryFolder + ExtractFileName(Report.FileName), DefaultExt)
    else
      FileName := ChangeFileExt(GetTempFile, DefaultExt)
  end;
  FThumbImage.Width := 0;
  FThumbImage.Height := 0;
  if (FileName <> '') or Assigned(Stream) then
  begin
    if (ExtractFilePath(FileName) = '') and (DefaultPath <> '') then
      FileName := DefaultPath + '\' + FileName;
    FFirstPage := True;
    FMatrix := TfrxIEMatrix.Create(UseFileCache, Report.EngineOptions.TempDir);
    FMatrix.RotatedAsImage := False;
    FMatrix.ShowProgress := ShowProgress;
    FMatrix.Background := FBackground and FEmptyLines;
    FMatrix.BackgroundImage := False;
    FMatrix.Printable := ExportNotPrintable;
    FMatrix.RichText := not FExportEMF;
    FMatrix.PlainRich := not FExportEMF;
    FMatrix.EmptyLines := FEmptyLines;
    FMatrix.WrapText := True;
    FMatrix.EMFPictures := ExportEMF;  // added
    FExportPageBreaks := FExportPageBreaks and FEmptyLines;
    if FWysiwyg then
      FMatrix.Inaccuracy := 0.5
    else
      FMatrix.Inaccuracy := 10;
    FMatrix.DeleteHTMLTags := True;
    Result := True
  end
  else
    Result := False;
end;

procedure TfrxODFExport.StartPage(Page: TfrxReportPage; Index: Integer);
begin
  if FFirstPage then
  begin
    FPageLeft := Page.LeftMargin;
    FPageTop := Page.TopMargin;
    FPageBottom := Page.BottomMargin;
    FPageRight := Page.RightMargin;
    FPageOrientation := Page.Orientation;
    FPageWidth := Page.Width;
    FPageHeight := Page.Height;
    FThumbImage.Width := Round(Page.Width / 5);
    FThumbImage.Height := Round(Page.Height / 5);
  end;
end;

procedure TfrxODFExport.ExportObject(Obj: TfrxComponent);
begin
  if (Obj is TfrxView) and (ExportNotPrintable or TfrxView(Obj).Printable) then
  begin
    FMatrix.AddObject(TfrxView(Obj));
    if FFirstPage then
    begin
      FThumbImage.Canvas.Lock;
      try
        TfrxView(Obj).Draw(FThumbImage.Canvas, 0.2, 0.2, Obj.Left / 5, Obj.Top / 5);
      finally
        FThumbImage.Canvas.Unlock;
      end;
    end;
  end;
end;

procedure TfrxODFExport.FinishPage(Page: TfrxReportPage; Index: Integer);
begin
  FFirstPage := False;
  FMatrix.AddPage(Page.Orientation, Page.Width, Page.Height, Page.LeftMargin,
                  Page.TopMargin, Page.RightMargin, Page.BottomMargin);
end;

procedure TfrxODFExport.Finish;
var
  Exp: TStream;
begin
  FMatrix.Prepare;
  if ShowProgress then
    FProgress := TfrxProgress.Create(nil);
  try
    try
      if Assigned(Stream) then
        Exp := Stream
      else
        Exp := TFileStream.Create(FileName, fmCreate);
      try
        ExportPage(Exp);
      finally
        if not Assigned(Stream) then
          Exp.Free;
      end;
      if FOpenAfterExport and (not Assigned(Stream)) then
        ShellExecute(GetDesktopWindow, 'open', PChar(FileName), nil, nil, SW_SHOW);
    except
      on e: Exception do
        case Report.EngineOptions.NewSilentMode of
          simSilent:        Report.Errors.Add(e.Message);
          simMessageBoxes:  frxErrorMsg(e.Message);
          simReThrow:       raise;
        end;
    end;
  finally
    FMatrix.Free;
    if ShowProgress then
      FProgress.Free;
  end;
end;

destructor TfrxODFExport.Destroy;
begin
  FThumbImage.Free;
  inherited;
end;

procedure TfrxODFExport.DoOnProgress(Sender: TObject);
begin
  if ShowProgress then
    FProgress.Tick;
end;

{ TfrxODSExport }

constructor TfrxODSExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ExportType := 'spreadsheet';
  FilterDesc := frxResources.Get('ODSExportFilter');
  DefaultExt := frxGet(8960);
  ExportTitle := frxResources.Get('ODSExport');
end;

class function TfrxODSExport.GetDescription: String;
begin
  Result := frxResources.Get('ODSExport');
end;

{ TfrxODTExport }

constructor TfrxODTExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ExportType := 'text';
  FilterDesc := frxResources.Get('ODTExportFilter');
  DefaultExt := frxGet(8961);
  ExportTitle := frxResources.Get('ODTExport');
end;

class function TfrxODTExport.GetDescription: String;
begin
  Result := frxResources.Get('ODTExport');
end;

{ TfrxODFExportDialog }

procedure TfrxODFExportDialog.FormCreate(Sender: TObject);
begin
  OkB.Caption := frxGet(1);
  CancelB.Caption := frxGet(2);
  GroupPageRange.Caption := frxGet(7);
  AllRB.Caption := frxGet(3);
  CurPageRB.Caption := frxGet(4);
  PageNumbersRB.Caption := frxGet(5);
  DescrL.Caption := frxGet(9);
  GroupQuality.Caption := frxGet(8);
  ContinuousCB.Caption := frxGet(8950);
  PageBreaksCB.Caption := frxGet(6);
  WCB.Caption := frxGet(8102);
  BackgrCB.Caption := frxGet(8103);
  OpenCB.Caption := frxGet(8706);

  if UseRightToLeftAlignment then
    FlipChildren(True);
end;


procedure TfrxODFExportDialog.PageNumbersEChange(Sender: TObject);
begin
  PageNumbersRB.Checked := True;
end;

procedure TfrxODFExportDialog.PageNumbersEKeyPress(Sender: TObject;
  var Key: Char);
begin
  case key of
    '0'..'9':;
    #8, '-', ',':;
  else
    key := #0;
  end;
end;

procedure TfrxODFExportDialog.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_F1 then
    frxResources.Help(Self);
end;

end.