{ fpsopendocument.pas Writes an OpenDocument 1.0 Spreadsheet document An OpenDocument document is a compressed ZIP file with the following files inside: content.xml - Actual contents meta.xml - Authoring data settings.xml - User persistent viewing information, such as zoom, cursor position, etc. styles.xml - Styles, which are the only way to do formatting mimetype - application/vnd.oasis.opendocument.spreadsheet META-INF\manifest.xml - Describes the other files in the archive Specifications obtained from: http://docs.oasis-open.org/office/v1.1/OS/OpenDocument-v1.1.pdf AUTHORS: Felipe Monteiro de Carvalho / Jose Luis Jurado Rincon } unit fpsopendocument; {$ifdef fpc} {$mode delphi} {$endif} interface uses Classes, SysUtils, fpszipper, {NOTE: fpszipper is the latest zipper.pp Change to standard zipper when FPC 2.8 is released} fpspreadsheet, xmlread, DOM, AVL_Tree, math, fpsutils; type { TsSpreadOpenDocReader } TsSpreadOpenDocReader = class(TsCustomSpreadReader) private FWorksheet: TsWorksheet; function GetAttrValue(ANode : TDOMNode; AAttrName : string) : string; public { General reading methods } procedure ReadFromFile(AFileName: string; AData: TsWorkbook); override; { Record writing methods } procedure ReadFormula(ARow : Word; ACol : Word; ACellNode: TDOMNode); procedure ReadLabel(ARow : Word; ACol : Word; ACellNode: TDOMNode); procedure ReadNumber(ARow : Word; ACol : Word; ACellNode: TDOMNode); end; { TsSpreadOpenDocWriter } TsSpreadOpenDocWriter = class(TsCustomSpreadWriter) protected FPointSeparatorSettings: TFormatSettings; // Strings with the contents of files FMeta, FSettings, FStyles, FContent, FMimetype: string; FMetaInfManifest: string; // Streams with the contents of files FSMeta, FSSettings, FSStyles, FSContent, FSMimetype: TStringStream; FSMetaInfManifest: TStringStream; // Routines to write those files procedure WriteMimetype; procedure WriteMetaInfManifest; procedure WriteMeta; procedure WriteSettings; procedure WriteStyles; procedure WriteContent(AData: TsWorkbook); procedure WriteWorksheet(CurSheet: TsWorksheet); // Routines to write parts of those files function WriteStylesXMLAsString: string; public constructor Create; override; { General writing methods } procedure WriteStringToFile(AString, AFileName: string); procedure WriteToFile(const AFileName: string; AData: TsWorkbook; const AOverwriteExisting: Boolean = False); override; procedure WriteToStream(AStream: TStream; AData: TsWorkbook); override; { Record writing methods } procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsFormula); override; procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string; ACell: PCell); override; procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); override; end; implementation const { OpenDocument general XML constants } XML_HEADER = ''; { OpenDocument Directory structure constants } OPENDOC_PATH_CONTENT = 'content.xml'; OPENDOC_PATH_META = 'meta.xml'; OPENDOC_PATH_SETTINGS = 'settings.xml'; OPENDOC_PATH_STYLES = 'styles.xml'; OPENDOC_PATH_MIMETYPE = 'mimetype'; OPENDOC_PATH_METAINF = 'META-INF' + '/'; OPENDOC_PATH_METAINF_MANIFEST = 'META-INF' + '/' + 'manifest.xml'; { OpenDocument schemas constants } SCHEMAS_XMLNS_OFFICE = 'urn:oasis:names:tc:opendocument:xmlns:office:1.0'; SCHEMAS_XMLNS_DCTERMS = 'http://purl.org/dc/terms/'; SCHEMAS_XMLNS_META = 'urn:oasis:names:tc:opendocument:xmlns:meta:1.0'; SCHEMAS_XMLNS = 'http://schemas.openxmlformats.org/officeDocument/2006/extended-properties'; SCHEMAS_XMLNS_CONFIG = 'urn:oasis:names:tc:opendocument:xmlns:config:1.0'; SCHEMAS_XMLNS_OOO = 'http://openoffice.org/2004/office'; SCHEMAS_XMLNS_MANIFEST = 'urn:oasis:names:tc:opendocument:xmlns:manifest:1.0'; SCHEMAS_XMLNS_FO = 'urn:oasis:names:tc:opendocument:xmlns:xsl-fo-compatible:1.0'; SCHEMAS_XMLNS_STYLE = 'urn:oasis:names:tc:opendocument:xmlns:style:1.0'; SCHEMAS_XMLNS_SVG = 'urn:oasis:names:tc:opendocument:xmlns:svg-compatible:1.0'; SCHEMAS_XMLNS_TABLE = 'urn:oasis:names:tc:opendocument:xmlns:table:1.0'; SCHEMAS_XMLNS_TEXT = 'urn:oasis:names:tc:opendocument:xmlns:text:1.0'; SCHEMAS_XMLNS_V = 'urn:schemas-microsoft-com:vml'; SCHEMAS_XMLNS_NUMBER = 'urn:oasis:names:tc:opendocument:xmlns:datastyle:1.0'; SCHEMAS_XMLNS_CHART = 'urn:oasis:names:tc:opendocument:xmlns:chart:1.0'; SCHEMAS_XMLNS_DR3D = 'urn:oasis:names:tc:opendocument:xmlns:dr3d:1.0'; SCHEMAS_XMLNS_MATH = 'http://www.w3.org/1998/Math/MathML'; SCHEMAS_XMLNS_FORM = 'urn:oasis:names:tc:opendocument:xmlns:form:1.0'; SCHEMAS_XMLNS_SCRIPT = 'urn:oasis:names:tc:opendocument:xmlns:script:1.0'; SCHEMAS_XMLNS_OOOW = 'http://openoffice.org/2004/writer'; SCHEMAS_XMLNS_OOOC = 'http://openoffice.org/2004/calc'; SCHEMAS_XMLNS_DOM = 'http://www.w3.org/2001/xml-events'; SCHEMAS_XMLNS_XFORMS = 'http://www.w3.org/2002/xforms'; SCHEMAS_XMLNS_XSD = 'http://www.w3.org/2001/XMLSchema'; SCHEMAS_XMLNS_XSI = 'http://www.w3.org/2001/XMLSchema-instance'; { TsSpreadOpenDocReader } function TsSpreadOpenDocReader.GetAttrValue(ANode : TDOMNode; AAttrName : string) : string; var i : integer; Found : Boolean; begin Found:=false; i:=0; Result:=''; while not Found and (i'' then ReadFormula(Row+RowsCount,Col+ColsCount,CellNode) else if ParamValueType='float' then ReadNumber(Row+RowsCount,Col+ColsCount,CellNode); end; //for ColsCount end; //for RowsCount Inc(Col,ColsCount+1); CellNode:=CellNode.NextSibling; end; //while Assigned(CellNode) Inc(Row,RowsCount+1); RowNode:=RowNode.NextSibling; end; // while Assigned(RowNode) TableNode:=TableNode.NextSibling; end; //while Assigned(TableNode) finally Doc.Free; end; end; procedure TsSpreadOpenDocReader.ReadFormula(ARow: Word; ACol : Word; ACellNode : TDOMNode); begin // For now just read the number ReadNumber(ARow, ACol, ACellNode); end; procedure TsSpreadOpenDocReader.ReadLabel(ARow: Word; ACol : Word; ACellNode : TDOMNode); begin FWorkSheet.WriteUTF8Text(ARow,ACol,UTF8Encode(ACellNode.TextContent)); end; procedure TsSpreadOpenDocReader.ReadNumber(ARow: Word; ACol : Word; ACellNode : TDOMNode); var FSettings: TFormatSettings; Value, Str: String; lNumber: Double; begin FSettings.DecimalSeparator:='.'; Value:=GetAttrValue(ACellNode,'office:value'); if UpperCase(Value)='1.#INF' then begin FWorkSheet.WriteNumber(Arow,ACol,1.0/0.0); end else begin // Don't merge, or else we can't debug Str := GetAttrValue(ACellNode,'office:value'); lNumber := StrToFloat(Str,FSettings); FWorkSheet.WriteNumber(Arow,ACol,lNumber); end; end; { TsSpreadOpenDocWriter } procedure TsSpreadOpenDocWriter.WriteMimetype; begin FMimetype := 'application/vnd.oasis.opendocument.spreadsheet'; end; procedure TsSpreadOpenDocWriter.WriteMetaInfManifest; begin FMetaInfManifest := XML_HEADER + LineEnding + '' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ''; end; procedure TsSpreadOpenDocWriter.WriteMeta; begin FMeta := XML_HEADER + LineEnding + '' + LineEnding + ' ' + LineEnding + ' FPSpreadsheet Library' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ''; end; procedure TsSpreadOpenDocWriter.WriteSettings; begin FSettings := XML_HEADER + LineEnding + '' + LineEnding + '' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' Tabelle1' + LineEnding + ' 100' + LineEnding + ' 100' + LineEnding + ' false' + LineEnding + ' true' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' 3' + LineEnding + ' 2' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ''; end; procedure TsSpreadOpenDocWriter.WriteStyles; begin FStyles := XML_HEADER + LineEnding + '' + LineEnding + '' + LineEnding + ' ' + LineEnding + '' + LineEnding + '' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + '' + LineEnding + '' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + '' + LineEnding + '' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + '' + LineEnding + ''; end; procedure TsSpreadOpenDocWriter.WriteContent(AData: TsWorkbook); var i: Integer; lStylesCode: string; begin ListAllFormattingStyles(AData); lStylesCode := WriteStylesXMLAsString(); FContent := XML_HEADER + LineEnding + '' + LineEnding + ' ' + LineEnding + // Fonts ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + // Automatic styles ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + // Automatically Generated Styles lStylesCode + ' ' + LineEnding + // Body ' ' + LineEnding + ' ' + LineEnding; // Write all worksheets for i := 0 to AData.GetWorksheetCount - 1 do begin WriteWorksheet(Adata.GetWorksheetByIndex(i)); end; FContent := FContent + ' ' + LineEnding + ' ' + LineEnding + ''; end; procedure TsSpreadOpenDocWriter.WriteWorksheet(CurSheet: TsWorksheet); var j, k: Integer; CurCell: PCell; CurRow: array of PCell; LastColNum: Cardinal; LCell: TCell; AVLNode: TAVLTreeNode; begin LastColNum := CurSheet.GetLastColNumber; // Header FContent := FContent + ' ' + LineEnding + ' ' + LineEnding; // The cells need to be written in order, row by row, cell by cell for j := 0 to CurSheet.GetLastRowNumber do begin FContent := FContent + ' ' + LineEnding; // Write cells from this row. for k := 0 to LastColNum do begin LCell.Row := j; LCell.Col := k; AVLNode := CurSheet.Cells.Find(@LCell); if Assigned(AVLNode) then WriteCellCallback(PCell(AVLNode.Data), nil) else FContent := FContent + '' + LineEnding; end; FContent := FContent + ' ' + LineEnding; end; // Footer FContent := FContent + ' ' + LineEnding; end; function TsSpreadOpenDocWriter.WriteStylesXMLAsString: string; var i: Integer; begin Result := ''; for i := 0 to Length(FFormattingStyles) - 1 do begin // Start and Name Result := Result + ' ' + LineEnding; // Fields if uffBold in FFormattingStyles[i].UsedFormattingFields then Result := Result + ' ' + LineEnding; if (uffBorder in FFormattingStyles[i].UsedFormattingFields) or (uffBackgroundColor in FFormattingStyles[i].UsedFormattingFields) then begin Result := Result + ' ' + LineEnding; end; // End Result := Result + ' ' + LineEnding; end; end; constructor TsSpreadOpenDocWriter.Create; begin inherited Create; FPointSeparatorSettings := SysUtils.DefaultFormatSettings; FPointSeparatorSettings.DecimalSeparator:='.'; end; { Writes a string to a file. Helper convenience method. } procedure TsSpreadOpenDocWriter.WriteStringToFile(AString, AFileName: string); var TheStream : TFileStream; S : String; begin TheStream := TFileStream.Create(AFileName, fmCreate); S:=AString; TheStream.WriteBuffer(Pointer(S)^,Length(S)); TheStream.Free; end; { Writes an OOXML document to the disc. } procedure TsSpreadOpenDocWriter.WriteToFile(const AFileName: string; AData: TsWorkbook; const AOverwriteExisting: Boolean); var FZip: TZipper; begin { Fill the strings with the contents of the files } WriteMimetype(); WriteMetaInfManifest(); WriteMeta(); WriteSettings(); WriteStyles(); WriteContent(AData); { Write the data to streams } FSMeta := TStringStream.Create(FMeta); FSSettings := TStringStream.Create(FSettings); FSStyles := TStringStream.Create(FStyles); FSContent := TStringStream.Create(FContent); FSMimetype := TStringStream.Create(FMimetype); FSMetaInfManifest := TStringStream.Create(FMetaInfManifest); { Now compress the files } FZip := TZipper.Create; try FZip.FileName := AFileName; FZip.Entries.AddFileEntry(FSMeta, OPENDOC_PATH_META); FZip.Entries.AddFileEntry(FSSettings, OPENDOC_PATH_SETTINGS); FZip.Entries.AddFileEntry(FSStyles, OPENDOC_PATH_STYLES); FZip.Entries.AddFileEntry(FSContent, OPENDOC_PATH_CONTENT); FZip.Entries.AddFileEntry(FSMimetype, OPENDOC_PATH_MIMETYPE); FZip.Entries.AddFileEntry(FSMetaInfManifest, OPENDOC_PATH_METAINF_MANIFEST); FZip.ZipAllFiles; finally FZip.Free; FSMeta.Free; FSSettings.Free; FSStyles.Free; FSContent.Free; FSMimetype.Free; FSMetaInfManifest.Free; end; end; procedure TsSpreadOpenDocWriter.WriteToStream(AStream: TStream; AData: TsWorkbook); begin // Not supported at the moment raise Exception.Create('TsSpreadOpenDocWriter.WriteToStream not supported'); end; procedure TsSpreadOpenDocWriter.WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsFormula); begin { // The row should already be the correct one FContent := FContent + ' ' + LineEnding + ' ' + AFormula.DoubleValue + '' + LineEnding + ' ' + LineEnding; 1833 } end; { Writes a cell with text content The UTF8 Text needs to be converted, because some chars are invalid in XML See bug with patch 19422 } procedure TsSpreadOpenDocWriter.WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string; ACell: PCell); var lStyle: string = ''; lIndex: Integer; begin if ACell^.UsedFormattingFields <> [] then begin lIndex := FindFormattingInList(ACell); lStyle := ' table:style-name="ce' + IntToStr(lIndex) + '" '; end; // The row should already be the correct one FContent := FContent + ' ' + LineEnding + ' ' + UTF8TextToXMLText(AValue) + '' + LineEnding + ' ' + LineEnding; end; procedure TsSpreadOpenDocWriter.WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); var StrValue: string; DisplayStr: string; lStyle: string = ''; begin if uffBold in ACell^.UsedFormattingFields then lStyle := ' table:style-name="bold" '; // The row should already be the correct one if IsInfinite(AValue) then begin StrValue:='1.#INF'; DisplayStr:='1.#INF'; end else begin StrValue:=FloatToStr(AValue,FPointSeparatorSettings); //Uses '.' as decimal separator DisplayStr:=FloatToStr(AValue); // Uses locale decimal separator end; FContent := FContent + ' ' + LineEnding + ' ' + DisplayStr + '' + LineEnding + ' ' + LineEnding; end; { Registers this reader / writer on fpSpreadsheet } initialization RegisterSpreadFormat(TsSpreadOpenDocReader, TsSpreadOpenDocWriter, sfOpenDocument); end.