frxexportxml.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

      WriteExpLn('</Style>');
    end;
    WriteExpLn('</Styles>');
  end;

  s := 'Page 1';
  WriteExpLn('<Worksheet ss:Name="' + UTF8Encode(s) + '">');
  WriteExpLn('<Table ss:ExpandedColumnCount="' + IntToStr(FMatrix.Width) + '"' +
    ' ss:ExpandedRowCount="' + IntToStr(FMatrix.Height) + '" x:FullColumns="1" x:FullRows="1">');
  OldSeparator := DecimalSeparator;
  DecimalSeparator := '.';
  for x := 1 to FMatrix.Width - 1 do
  begin
    dcol := (FMatrix.GetXPosById(x) - FMatrix.GetXPosById(x - 1)) / Xdivider;
    WriteExpLn('<Column ss:AutoFitWidth="0" ss:Width="' +
      FloatToStr(dcol) + '"/>');
  end;
  st := '';
  Page := 0;

  for y := 0 to FMatrix.Height - 2 do
  begin
    drow := (FMatrix.GetYPosById(y + 1) - FMatrix.GetYPosById(y)) / Ydivider;
    WriteExpLn('<Row ss:Height="' + FloatToStr(drow) + '">');
    if FMatrix.PagesCount > Page then
      if FMatrix.GetYPosById(y) >= FMatrix.GetPageBreak(Page) then
      begin
        Inc(Page);
        PageBreak.Add(IntToStr(y + 1));
        if FShowProgress then
        begin
          FProgress.Tick;
          if FProgress.Terminated then
            break;
        end;
      end;
    for x := 0 to FMatrix.Width - 1 do
    begin
      if FShowProgress then
        if FProgress.Terminated then
           break;
      si := ' ss:Index="' + IntToStr(x + 1) + '" ';
      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 Obj.IsText then
          begin
            if dx > 1 then
            begin
              s := 'ss:MergeAcross="' + IntToStr(dx - 1) + '" ';
              Inc(dx);
            end
            else
              s := '';
            if dy > 1 then
              sb := 'ss:MergeDown="' + IntToStr(dy - 1) + '" '
            else
              sb := '';
            if FExportStyles then
              st := 'ss:StyleID="' + 's' + IntToStr(Obj.StyleIndex) + '" '
            else
              st := '';
            WriteExpLn('<Cell' + si + s + sb + st + '>');
            s := TruncReturns(Obj.Memo.Text);
            if (Obj.DisplayFormat.Kind = fkNumeric) and IsDigits(s) then
            begin
              s := StringReplace(s, ThousandSeparator, '', [rfReplaceAll]);
              s := StringReplace(s, Obj.DisplayFormat.DecimalSeparator,
                DecimalSeparator, [rfReplaceAll]);
              si := ' ss:Type="Number"';
              WriteExpLn('<Data' + si + '>' + s + '</Data>');
            end
            else
            begin
              si := ' ss:Type="String"';
              s := ChangeReturns(s);
              WriteExpLn('<Data' + si + '>' + UTF8Encode(s) + '</Data>');
            end;
            WriteExpLn('</Cell>');
          end;
        end
      end
      else
        WriteExpLn('<Cell' + si + '/>');
    end;
    WriteExpLn('</Row>');
  end;

  WriteExpLn('</Table>');
  WriteExpLn('<WorksheetOptions xmlns="urn:schemas-microsoft-com:office:excel">');
  WriteExpLn('<PageSetup>');
  if FPageOrientation = poLandscape then
    WriteExpLn('<Layout x:Orientation="Landscape"/>');
  WriteExpLn('<PageMargins x:Bottom="' + FloatToStr(FPageBottom / MargDiv) +
    '" x:Left="' + FloatToStr(FPageLeft / MargDiv) +
    '" x:Right="' + FloatToStr(FPageRight / MargDiv) +
    '" x:Top="' + FloatToStr(FPageTop / MargDiv) + '"/>');
  WriteExpLn('</PageSetup>');
  WriteExpLn('</WorksheetOptions>');
  DecimalSeparator := OldSeparator;

  if FExportPageBreaks then
  begin
    WriteExpLn('<PageBreaks xmlns="urn:schemas-microsoft-com:office:excel">');
    WriteExpLn('<RowBreaks>');
    for i := 0 to FMatrix.PagesCount - 2 do
    begin
      WriteExpLn('<RowBreak>');
      WriteExpLn('<Row>' + PageBreak[i] + '</Row>');
      WriteExpLn('</RowBreak>');
    end;
    WriteExpLn('</RowBreaks>');
    WriteExpLn('</PageBreaks>');
  end;
  WriteExpLn('</Worksheet>');
  WriteExpLn('</Workbook>');
  PageBreak.Free;

  if FShowProgress then
    FProgress.Free;
end;

function TfrxXMLExport.ShowModal: TModalResult;
begin
  if not Assigned(Stream) then
  begin
    with TfrxXMLExportDialog.Create(nil) do
    begin
      StylesCB.Checked := FExportStyles;
      PageBreaksCB.Checked := FExportPageBreaks;
      WCB.Checked := FWysiwyg;
      OpenExcelCB.Checked := FOpenExcelAfterExport;
      BackgrCB.Checked := FBackground;
      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;
        FExportStyles := StylesCB.Checked;
        FWysiwyg := WCB.Checked;
        FOpenExcelAfterExport := OpenExcelCB.Checked;
        FBackground := BackgrCB.Checked;

        if SaveDialog1.Execute then
          FileName := SaveDialog1.FileName
        else
          Result := mrCancel;
      end;
      Free;
    end;
  end else
    Result := mrOk;
end;

function TfrxXMLExport.Start: Boolean;
begin
  if (FileName <> '') or Assigned(Stream) then
  begin
    FFirstPage := True;
    FMatrix := TfrxIEMatrix.Create;
    FMatrix.ShowProgress := ShowProgress;
    FMatrix.MaxCellHeight := XLMaxHeight * Ydivider;
    FMatrix.Background := FBackground;
    FMatrix.BackgroundImage := False;
    FMatrix.Printable := ExportNotPrintable;
    if FWysiwyg then
      FMatrix.Inaccuracy := 0.5
    else
      FMatrix.Inaccuracy := 10;
    FMatrix.DeleteHTMLTags := True;
    Result := True
  end
  else
    Result := False;
end;

procedure TfrxXMLExport.StartPage(Page: TfrxReportPage; Index: Integer);
begin
  if FFirstPage then
  begin
    FFirstPage := False;
    FPageLeft := Page.LeftMargin;
    FPageTop := Page.TopMargin;
    FPageBottom := Page.BottomMargin;
    FPageRight := Page.RightMargin;
    FPageOrientation := Page.Orientation;
  end;
end;

procedure TfrxXMLExport.ExportObject(Obj: TfrxComponent);
begin
  if Obj is TfrxView then
    FMatrix.AddObject(TfrxView(Obj));
end;

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

procedure TfrxXMLExport.Finish;
var
  Exp: TStream;
  Excel: Variant;
begin
  FMatrix.Prepare;
  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;
    try
      if FOpenExcelAfterExport and (not Assigned(Stream)) then
      begin
        Excel := CreateOLEObject('Excel.Application');
        Excel.Visible := True;
        Excel.WorkBooks.Open(FileName);
      end;
    finally
      Excel := Unassigned;
    end;
  except
    on e: Exception do
      if Report.EngineOptions.SilentMode then
        Report.Errors.Add(e.Message)
      else frxErrorMsg(e.Message);
  end;
  FMatrix.Free;
end;

function TfrxXMLExport.IsDigits(const Str: String): Boolean;
var
  i: Integer;
begin
  Result := True;
  for i := 1 to Length(Str) do
    if (Ord(Str[i]) < 48) or (Ord(Str[i]) > 57) or (Ord(Str[i]) <> 46) then
    begin
      Result := False;
      break;
    end;
end;

{ TfrxXMLExportDialog }

procedure TfrxXMLExportDialog.FormCreate(Sender: TObject);
begin
  frxResources.LocalizeForm(Self);
end;


end.