freepascal.ru

Код: Выделить всё

function TRxDBGridExportSpreadSheet.DoExecTools: boolean;
const
  FILE_EXT: array[0..4] of string = (
    '_excel2.xls', '_excel5.xls', '.xls', '.xlsx', '.ods');
var
  P:TBookMark;
  FPN, FFN: String;

  ssfCorrect : Boolean;
  ssfType    : TsSpreadsheetFormat;
  sExt       : String;
begin
  Result:=false;
  if (not Assigned(FRxDBGrid)) or (not Assigned(FRxDBGrid.DataSource)) or (not Assigned(FRxDBGrid.DataSource.DataSet)) then
    exit;
  if FPageName = '' then
    FPN:=sPageName
  else
    FPN:=FPageName;

  FFN:=InternalGetFileName;

  FDataSet:=FRxDBGrid.DataSource.DataSet;
  FDataSet.DisableControls;
  {$IFDEF NoAutomatedBookmark}
  P:=FDataSet.GetBookmark;
  {$ELSE}
  P:=FDataSet.Bookmark;
  {$ENDIF}

  FWorkbook  := TsWorkbook.Create;
  FWorksheet := nil;
  try

    if (ressOverwriteExisting in FOptions) then
    begin
      FWorksheet := FWorkbook.AddWorksheet(FPN);
    end
    else
    begin
       {
        +Возможно перезаписывать и добавлять листы.
        +Формулы работают
        -Повреждается информация о сводных таблицах
       }
       ssfCorrect:=False;
       If FileExists(UTF8ToSys(FFN)) then
       begin
            //UTF8RPos()>0;
            sExt := UTF8LowerCase(ExtractFileExt(FFN));
            case sExt of
              '.xls':
              begin
                if UTF8Pos(FILE_EXT[0], FFN) > 0 then
                  ssfType := sfExcel2
                else
                if UTF8Pos(FILE_EXT[1], FFN) > 0 then
                  ssfType := sfExcel5
                else
                  ssfType    := sfExcel8;
                  ssfCorrect := True;
              end;
              '.xlsx':
              begin
                ssfType := sfOOXML;
                ssfCorrect := True;
              end;
              '.ods':
              begin
                ssfType := sfOpenDocument;
                ssfCorrect := True;
              end
              else
              begin
                Application.MessageBox('Unknown file format.', PChar(Application.Title),MB_ICONERROR);
              end;
            end;
       end;

       if ssfCorrect then
       begin
          FWorkbook.Options:=FWorkbook.Options+[boReadFormulas,boIgnoreFormulas];

          FWorkbook.ReadFromFile(UTF8ToSys(FFN),ssfType);
          FWorksheet := FWorkbook.GetWorksheetByName(FPN);

          if Assigned(FWorksheet) then
          begin
            FWorksheet.Clear;
          end
          else begin
            FWorksheet := FWorkbook.AddWorksheet(FPN);
          end;
          //fullCalcOnLoad - not tested
       end;
    end;

    if Assigned(FWorksheet) then
    begin
      scColorBlack:=FRxDBGrid.GridLineColor;
      FCurRow:=0;
      FFirstDataRow:=0;
      FLastDataRow:=-1;

      if ressExportTitle in FOptions then
        DoExportTitle;
      DoExportBody;

      if (ressExportFooter in FOptions) and (RxDBGrid.FooterOptions.Active) and (RxDBGrid.FooterOptions.RowCount>0) then
        DoExportFooter;

      DoExportColWidth;

      FWorkbook.WriteToFile(UTF8ToSys(FFN), True);
      Result:=true;
    end;

  finally
    FWorkbook.Free;
    {$IFDEF NoAutomatedBookmark}
    FDataSet.GotoBookmark(P);
    FDataSet.FreeBookmark(P);
    {$ELSE}
    FDataSet.Bookmark:=P;
    {$ENDIF}
    FDataSet.EnableControls;
  end;

  if Result and FOpenAfterExport then
    OpenDocument(FFN);
end;