{ xlsxooxml.pas Writes an OOXML (Office Open XML) document An OOXML document is a compressed ZIP file with the following files inside: [Content_Types].xml - _rels/.rels - xl/_rels\workbook.xml.rels - xl/workbook.xml - Global workbook data and list of worksheets xl/styles.xml - xl/sharedStrings.xml - xl/worksheets\sheet1.xml - Contents of each worksheet ... xl/worksheets\sheetN.xml Specifications obtained from: http://openxmldeveloper.org/default.aspx also: http://office.microsoft.com/en-us/excel-help/excel-specifications-and-limits-HP010073849.aspx#BMworksheetworkbook AUTHORS: Felipe Monteiro de Carvalho, Reinier Olislagers, Werner Pamler } unit xlsxooxml; {$ifdef fpc} {$mode objfpc}{$H+} {$endif} {$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined} interface uses Classes, SysUtils, laz2_xmlread, laz2_DOM, avglvltree, {$IF FPC_FULLVERSION >= 20701} zipper, {$ELSE} fpszipper, {$ENDIF} fpsTypes, fpsUtils, fpsReaderWriter, fpsNumFormat, fpsPalette, fpsConditionalFormat, fpsxmlcommon, xlsCommon; type { TsSpreadOOXMLReader } TsSpreadOOXMLReader = class(TsSpreadXMLReader) private FDateMode: TDateMode; FPointSeparatorSettings: TFormatSettings; FSharedStrings: TStringList; FSheetList: TFPList; FFillList: TFPList; FBorderList: TFPList; FHyperlinkList: TFPList; FSharedFormulaBaseList: TFPList; FPalette: TsPalette; FThemeColors: array of TsColor; FLastRow, FLastCol: Cardinal; FWrittenByFPS: Boolean; procedure ApplyCellFormatting(ACell: PCell; XfIndex: Integer); procedure ApplyHyperlinks(AWorksheet: TsBasicWorksheet); function FindCommentsFileName(ANode: TDOMNode): String; procedure ReadActiveSheet(ANode: TDOMNode; out ActiveSheetIndex: Integer); procedure ReadBorders(ANode: TDOMNode); function ReadBorderStyle(ANode: TDOMNode; out ABorderStyle: TsCellBorderStyle): Boolean; procedure ReadCell(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARowIndex: Cardinal; var AColIndex: Cardinal); procedure ReadCellXfs(ANode: TDOMNode); procedure ReadCFAverage(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARange: TsCellRange; AFormatIndex: Integer); procedure ReadCFCellFormat(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARange: TsCellRange; AFormatIndex: Integer); procedure ReadCFColorRange(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARange: TsCellRange); procedure ReadCFDataBars(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARange: TsCellRange); procedure ReadCFDateFormat(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARange: TsCellRange; AFormatIndex: Integer); procedure ReadCFExpression(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARange: TsCellRange; AFormatIndex: Integer); procedure ReadCFIconSet(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARange: TsCellRange); procedure ReadCFMisc(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARange: TsCellRange; AFormatIndex: Integer); procedure ReadCFTop10(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARange: TsCellRange; AFormatIndex: Integer); procedure ReadColRowBreaks(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); function ReadColor(ANode: TDOMNode): TsColor; procedure ReadCols(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadComments(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadConditionalFormatting(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadDateMode(ANode: TDOMNode); procedure ReadDefinedNames(ANode: TDOMNode); procedure ReadDifferentialFormat(ANode: TDOMNode); procedure ReadDifferentialFormats(ANode: TDOMNode); procedure ReadDimension(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadFileVersion(ANode: TDOMNode); procedure ReadFills(ANode: TDOMNode); function ReadFont(ANode: TDOMNode): Integer; procedure ReadFonts(ANode: TDOMNode); procedure ReadHeaderFooter(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadHyperlinks(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadMetaData(ANode: TDOMNode); procedure ReadMergedCells(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadNumFormats(ANode: TDOMNode); procedure ReadPageMargins(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadPageSetup(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadPalette(ANode: TDOMNode); procedure ReadPrintOptions(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadRow(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; var ARowIndex: Cardinal); procedure ReadSharedStrings(ANode: TDOMNode); procedure ReadSheetFormatPr(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadSheetList(ANode: TDOMNode); procedure ReadSheetPr(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadSheetProtection(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadSheetViews(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadThemeElements(ANode: TDOMNode); procedure ReadThemeColors(ANode: TDOMNode); procedure ReadWorkbookProtection(ANode: TDOMNode); procedure ReadWorksheet(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); protected FFirstNumFormatIndexInFile: Integer; procedure AddBuiltinNumFormats; override; public constructor Create(AWorkbook: TsBasicWorkbook); override; destructor Destroy; override; class function CheckFileFormat(AStream: TStream): Boolean; override; procedure ReadFromStream(AStream: TStream; APassword: String = ''; AParams: TsStreamParams = []); override; end; { TsSpreadOOXMLWriter } TsSpreadOOXMLWriter = class(TsCustomSpreadWriter) private FFirstNumFormatIndexInFile: Integer; vmlDrawingCounter: Integer; protected FDateMode: TDateMode; FPointSeparatorSettings: TFormatSettings; FSharedStringsCount: Integer; FFillList: array of PsCellFormat; FBorderList: array of PsCellFormat; FDifferentialFormatIndexList: array of Integer; function GetActiveTab: String; procedure Get_rId(AWorksheet: TsBasicWorksheet; out AComment_rId, AFirstHyperlink_rId, ADrawing_rId, ADrawingHF_rId: Integer); protected procedure AddBuiltinNumFormats; override; procedure CreateStreams; procedure DestroyStreams; function FindBorderInList(AFormat: PsCellFormat): Integer; function FindFillInList(AFormat: PsCellFormat): Integer; function GetStyleIndex(ACell: PCell): Cardinal; procedure ListAllBorders; procedure ListAllDifferentialFormats; procedure ListAllFills; function PrepareFormula(const AFormula: String): String; procedure ResetStreams; procedure WriteBorderList(AStream: TStream); procedure WriteCFCellRule(AStream: TStream; ARule: TsCFCellRule; ARange: TsCellRange; APriority: Integer); procedure WriteCFColorRangeRule(AStream: TStream; ARule: TsCFColorRangeRule; APriority: Integer); procedure WriteCFDataBarRule(AStream: TStream; ARule: TsCFDatabarRule; APriority: Integer); procedure WriteCFIconSetRule(AStream: TStream; ARule: TsCFIconSetRule; APriority: Integer); procedure WriteColBreaks(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteCols(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteComments(AWorksheet: TsBasicWorksheet); procedure WriteConditionalFormat(AStream: TStream; AFormat: TsConditionalFormat; var APriority: Integer); procedure WriteConditionalFormats(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteCustomMetaData(AStream: TStream); procedure WriteDefinedNames(AStream: TStream); procedure WriteDifferentialFormat(AStream: TStream; AFormat: PsCellFormat); procedure WriteDifferentialFormats(AStream: TStream); procedure WriteDimension(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteDrawings(AWorksheet: TsBasicWorksheet); procedure WriteDrawingRels(AWorksheet: TsBasicWorksheet); // procedure WriteDrawingsOfSheet(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteFillList(AStream: TStream); procedure WriteFont(AStream: TStream; AFont: TsFont; UseInStyleNode: Boolean); procedure WriteFontList(AStream: TStream); procedure WriteHeaderFooter(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteHyperlinks(AStream: TStream; AWorksheet: TsBasicWorksheet; rId: Integer); procedure WriteMetadata(AStream: TStream); procedure WriteMergedCells(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteNumFormatList(AStream: TStream); procedure WritePalette(AStream: TStream); procedure WritePageMargins(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WritePageSetup(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WritePrintOptions(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteRowBreaks(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteSheetData(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteSheetFormatPr(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteSheetPr(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteSheetProtection(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteSheets(AStream: TStream); procedure WriteSheetViews(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteStyle(AStream: TStream; ANodeName: String; AFormat: PsCellFormat); procedure WriteStyleList(AStream: TStream; ANodeName: String); procedure WriteVmlDrawings(AWorksheet: TsBasicWorksheet); procedure WriteVMLDrawings_Comments(AWorksheet: TsBasicWorksheet); procedure WriteVMLDrawings_HeaderFooterImages(AWorksheet: TsBasicWorksheet); procedure WriteVMLDrawingRels(AWorksheet: TsBasicWorksheet); procedure WriteWorkbook(AStream: TStream); procedure WriteWorkbookProtection(AStream: TStream); procedure WriteWorkbookRels(AStream: TStream); procedure WriteWorksheet(AWorksheet: TsBasicWorksheet); procedure WriteWorksheetRels(AWorksheet: TsBasicWorksheet); protected { Streams with the contents of files } FSContentTypes: TStream; FSRelsRels: TStream; FSWorkbook: TStream; FSWorkbookRels: TStream; FSMetaData: TStream; FSCustomMetaData: TStream; FSStyles: TStream; FSSharedStrings: TStream; FSSharedStrings_complete: TStream; FSMedia: array of TStream; FSSheets: array of TStream; FSSheetRels: array of TStream; FSComments: array of TStream; FSDrawings: array of TStream; FSDrawingsRels: array of TStream; FSVmlDrawings: array of TStream; FSVmlDrawingsRels: array of TStream; FCurSheetNum: Integer; protected { Routines to write the files } procedure WriteContent; procedure WriteContentTypes; procedure WriteGlobalFiles; procedure WriteMedia(AZip: TZipper); protected { Record writing methods } //todo: add WriteDate procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); override; procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal; const AValue: Boolean; ACell: PCell); override; procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); override; procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell); override; procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); override; procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; const AValue: string; ACell: PCell); override; procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); override; public constructor Create(AWorkbook: TsBasicWorkbook); override; { General writing methods } procedure WriteStringToFile(AFileName, AString: string); procedure WriteToStream(AStream: TStream; AParams: TsStreamParams = []); override; end; TXlsxSettings = record DateMode: TDateMode; end; var {@@ Default settings for reading/writing of XLSX files } XlsxSettings: TXlsxSettings = ( DateMode: dm1900; ); sfidOOXML: TsSpreadFormatID; procedure InitOOXMLLimitations(out ALimitations: TsSpreadsheetFormatLimitations); implementation uses variants, strutils, dateutils, math, lazutf8, LazFileUtils, uriparser, typinfo, {%H-}fpsPatches, fpSpreadsheet, fpsCrypto, fpsExprParser, fpsStrings, fpsStreams, fpsClasses, fpsImages; const { OOXML general XML constants } XML_HEADER = ''; { OOXML Directory structure constants } // Note: directory separators are always / because the .xlsx is a zip file which // requires / instead of \, even on Windows; see // http://www.pkware.com/documents/casestudies/APPNOTE.TXT // 4.4.17.1 All slashes MUST be forward slashes '/' as opposed to backward slashes '\' OOXML_PATH_TYPES = '[Content_Types].xml'; {%H-}OOXML_PATH_RELS = '_rels/'; OOXML_PATH_RELS_RELS = '_rels/.rels'; {%H-}OOXML_PATH_XL = 'xl/'; {%H-}OOXML_PATH_XL_RELS = 'xl/_rels/'; OOXML_PATH_XL_RELS_RELS = 'xl/_rels/workbook.xml.rels'; OOXML_PATH_XL_WORKBOOK = 'xl/workbook.xml'; OOXML_PATH_XL_STYLES = 'xl/styles.xml'; OOXML_PATH_XL_STRINGS = 'xl/sharedStrings.xml'; OOXML_PATH_XL_WORKSHEETS = 'xl/worksheets/'; OOXML_PATH_XL_WORKSHEETS_RELS = 'xl/worksheets/_rels/'; OOXML_PATH_XL_DRAWINGS = 'xl/drawings/'; OOXML_PATH_XL_DRAWINGS_RELS = 'xl/drawings/_rels/'; OOXML_PATH_XL_THEME = 'xl/theme/theme1.xml'; OOXML_PATH_XL_MEDIA = 'xl/media/'; OOXML_PATH_DOCPROPS_CORE = 'docProps/core.xml'; OOXML_PATH_DOCPROPS_CUSTOM = 'docProps/custom.xml'; { OOXML schemas constants } SCHEMAS_TYPES = 'http://schemas.openxmlformats.org/package/2006/content-types'; SCHEMAS_RELS = 'http://schemas.openxmlformats.org/package/2006/relationships'; SCHEMAS_DOC_RELS = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships'; SCHEMAS_DOCUMENT = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument'; SCHEMAS_META_CORE = 'http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties'; SCHEMAS_META_CUSTOM = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/custom-properties'; SCHEMAS_WORKSHEET = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/worksheet'; SCHEMAS_STYLES = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/styles'; SCHEMAS_STRINGS = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/sharedStrings'; SCHEMAS_COMMENTS = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments'; SCHEMAS_DRAWING = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/drawing'; SCHEMAS_VMLDRAWING = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/vmlDrawing'; SCHEMAS_HYPERLINK = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink'; SCHEMAS_IMAGE = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/image'; SCHEMAS_SPREADML = 'http://schemas.openxmlformats.org/spreadsheetml/2006/main'; SCHEMAS_CORE = 'http://schemas.openxmlformats.org/package/2006/metadata/core-properties'; { OOXML mime types constants } MIME_XML = 'application/xml'; MIME_RELS = 'application/vnd.openxmlformats-package.relationships+xml'; MIME_OFFICEDOCUMENT = 'application/vnd.openxmlformats-officedocument'; MIME_CORE = 'application/vnd.openxmlformats-package.core-properties+xml'; MIME_CUSTOM = 'application/vnd.openxmlformats-officedocument.custom-properties+xml'; MIME_SPREADML = MIME_OFFICEDOCUMENT + '.spreadsheetml'; MIME_SHEET = MIME_SPREADML + '.sheet.main+xml'; MIME_WORKSHEET = MIME_SPREADML + '.worksheet+xml'; MIME_STYLES = MIME_SPREADML + '.styles+xml'; MIME_STRINGS = MIME_SPREADML + '.sharedStrings+xml'; MIME_COMMENTS = MIME_SPREADML + '.comments+xml'; MIME_DRAWING = MIME_OFFICEDOCUMENT + '.drawing+xml'; // 'application/vnd.openxmlformats-officedocument.drawing+xml MIME_VMLDRAWING = MIME_OFFICEDOCUMENT + '.vmlDrawing'; LAST_PALETTE_INDEX = 63; type TFillListData = class PatternType: String; FgColor: TsColor; BgColor: Tscolor; end; TBorderListData = class Borders: TsCellBorders; BorderStyles: TsCellBorderStyles; end; TDifferentialFormatData = class CellFormatIndex: Integer; UsedFormattingFields: TsUsedFormattingFields; Borders: TsCellBorders; BorderStyles: TsCellBorderStyles; FillPatternType: TsFillStyle; FillFgColor: TsColor; FillBgColor: TsColor; FontColor: TsColor; FontStyles: TsFontStyles; NumFormatStr: String; end; THyperlinkListData = class ID: String; CellRef: String; Target: String; TextMark: String; Display: String; Tooltip: String; Worksheet: TsBasicWorksheet; end; TSharedFormulaData = class Worksheet: TsWorksheet; Row: Integer; Col: Integer; Formula: String; end; TSheetData = class Name: String; ID: String; Hidden: Boolean; end; const PATTERN_TYPES: array [TsFillStyle] of string = ( 'none', // fsNoFill 'solid', // fsSolidFill 'darkGray', // fsGray75 'mediumGray', // fsGray50 'lightGray', // fsGray25 'gray125', // fsGray12 'gray0625', // fsGray6, 'darkHorizontal', // fsStripeHor 'darkVertical', // fsStripeVert 'darkUp', // fsStripeDiagUp 'darkDown', // fsStripeDiagDown 'lightHorizontal', // fsThinStripeHor 'lightVertical', // fsThinStripeVert 'lightUp', // fsThinStripeDiagUp 'lightDown', // fsThinStripeDiagDown 'darkTrellis', // fsHatchDiag 'lightTrellis', // fsHatchThinDiag 'darkTellis', // fsHatchThickDiag 'lightGrid' // fsHatchThinHor ); LINESTYLE_TYPES: array[TsLineStyle] of String = ( 'thin', // lsThin 'medium', // lsMedium 'dashed', // lsDashed 'dotted', // lsDotted 'thick', // lsThick 'double', // lsDouble 'hair', // lsHair 'mediumDashed', // lsMediumDash 'dashDot', // lsDashDot 'mediumDashDot', // lsMediumDashDot 'dashDotDot', // lsDashDotDot 'mediumDashDotDot', // lsMediumDashDotDot 'slantDashDot' // lsSlantDashDot ); CF_TYPE_NAMES: array[TsCFCondition] of String = ( 'cellIs', 'cellIs', // cfcEqual, cfcNotEqual, 'cellIs', 'cellIs', 'cellIs', 'cellIs', // cfcGreaterThan, cfcLessThan, cfcGreaterEqual, cfcLessEqual, 'cellIs', 'cellIs', // cfcBetween, cfcNotBetween, 'aboveAverage', 'aboveAverage', 'aboveAverage', 'aboveAverage', // cfcAboveAverage, cfcBelowAverage, cfcAboveEqualAverage, cfcBelowEqualAverage, 'top10', 'top10', 'top10', 'top10', // cfcTop, cfcBottom, cfcTopPercent, cfcBottomPercent, 'duplicateValues', 'uniqueValues', // cfcDuplicate, cfcUnique, 'beginsWith', 'endsWith', // cfcBeginsWith, cfcEndsWith, 'containsText', 'notContainsText', // cfcContainsText, cfcNotContainsText, 'containsErrors', 'notContainsErrors', // cfcContainsErrors, cfcNotContainsErrors 'timePeriod', 'timePeriod', 'timePeriod',// cfcYesterday, cfcToday, cfcTomorrow 'timePeriod', // cfcLast7Days 'timePeriod', 'timePeriod', 'timePeriod',// cfcLastWeek, cfcThisWeek, cfcNextWeek 'timePeriod', 'timePeriod', 'timePeriod',// cfcLastMonth, cfcThisMonth, cfcNextMonth 'expression', 'expression', 'expression',// cfcLastYear, cfcThisYear, cfcNextYear // implemented as expression 'expression' // cfcExpression ); CF_OPERATOR_NAMES: array[TsCFCondition] of string = ( 'equal', 'notEqual', 'greaterThan', 'lessThan', 'greaterThanOrEqual', 'lessThanOrEqual', 'between', 'notBetween', '', '', '', '', // cfcAboveAverage, cfcBelowAverage, cfcAboveEqualAverage, cfcBelowEqualAverage, '', '', '', '', // cfcTop, cfcBottom, cfcTopPercent, cfcBottomPercent, '', '', // cfcDuplicate, cfcUnique, '', '', '', 'notContains', //cfcBeginsWith, cfcEndsWith, cfcContainsText, cfcNotContainsText, '', '', // cfcContainsErrors, cfcNotContainsErrors 'yesterday', 'today', 'tomorrow', 'last7Days', // cfcYesterday, cfcToday, cfcTomorrow, cfcLast7Days 'lastWeek', 'thisWeek', 'nextWeek', // cfcLastWeek, cfcThisWeek, cfcNextWeek 'lastMonth', 'thisMonth', 'nextMonth', // cfcLastMonth, cfcThisMonth, cfcNextMonth '', '', '', // cfcLastYear, cfcThisYear, cfcNextYear '' // cfcExpression ); CF_YEAR_FORMULAS: array[cfcLastYear..cfcNextYear] of string = ( 'YEAR(%0:s)=YEAR(TODAY())-1', // cfcLastYear 'YEAR(%0:s)=YEAR(TODAY())', // cfcThisYear 'YEAR(%0:s)=YEAR(TODAY())+1' // cfcNextYear ); CF_ICON_SET: array[TsCFIconSet] of string = ( '3Arrows', '3ArrowsGray','3Flags', // is3Arrows, is3ArrowsGray, is3Flags '3TrafficLights2', // REPLACEMENT FOR is3TrafficLights1 which requires x14 '3TrafficLights', // is3TrafficLights2 '3Signs', '3Symbols', '3Symbols2', // is3Signs, is3Symbols, is3Symbols2 '3Signs', '3Signs', '3Signs', '3Signs', // REPLACEMENT FOR is3Smilies, is3Stars, is3Triangles, is3ColorSmilies which need x14 '4Arrows', '4ArrowsGray', // is4Arrows, is4ArrowsGray '4RedToBlack', '4Rating', // is4RedToBlack, is4Rating '4TrafficLights', // is4TrafficLights, '5Arrows', '5ArrowsGray', // is5Arrows, is5ArrowsGray, '5Rating', '5Quarters', // is5Rating, is5Quarters, '5Quarters' // REPLACEMENT FOR is5Boxes which needs x14 ); function StrToFillStyle(s: String): TsFillStyle; var fs: TsFillStyle; begin if s = '' then begin Result := fsSolidFill; exit; end; for fs in TsFillStyle do if PATTERN_TYPES[fs] = s then begin Result := fs; exit; end; Result := fsNoFill; end; function StrToLineStyle(s: String): TsLineStyle; var ls: TsLineStyle; begin if s = '' then begin Result := lsThin; exit; end; for ls in TsLineStyle do if LINESTYLE_TYPES[ls] = s then begin Result := ls; exit; end; Result := lsThin; end; function StrToCFValueKind(s: String): TsCFValueKind; begin case s of 'min', 'automin': Result := vkMin; 'max', 'automax': Result := vkMax; 'percent': Result := vkPercent; 'percentile': Result := vkPercentile; 'num': Result := vkValue; else Result := vkMin; end; end; function CFOperandToStr(v: Variant): String; const ERR = cardinal(-1); var r, c: Cardinal; begin Result := VarToStr(v); if Result = '' then exit; if Result[1] = '=' then Delete(Result, 1, 1) else if ParseCellString(Result, r, c) and (r <> ERR) and (c <> ERR) then Result := GetCellString(r, c, []) else if VarIsStr(v) then Result := UTF8TextToXMLText(SafeQuoteStr(Result)); end; procedure InitOOXMLLimitations(out ALimitations: TsSpreadsheetFormatLimitations); begin // http://en.wikipedia.org/wiki/List_of_spreadsheet_software#Specifications ALimitations.MaxColCount := 16384; aLimitations.MaxRowCount := 1048576; ALimitations.MaxSheetNameLength := 31; // https://support.office.com/en-us/article/Excel-specifications-and-limits-1672b34d-7043-467e-8e27-269d656771c3#ID0EBABAAA=Excel_2007 ALimitations.MaxCharsInTextCell := 32767; end; function StrIsTrue(s: String): boolean; begin Result := (s = '1') or (Lowercase(s) = 'true'); end; function StrIsFalse(s: String): boolean; begin Result := (s = '0') or (Lowercase(s) = 'false'); end; function CF_ValueNode(AKind: TsCFValueKind; AValue: Double): String; begin Result := ''; end; function CF_ColorNode(AColor: TsColor): String; begin Result := Format('', [ColorToHTMLColorStr(AColor, true)]); end; {------------------------------------------------------------------------------} { TsSpreadOOXMLReader } {------------------------------------------------------------------------------} constructor TsSpreadOOXMLReader.Create(AWorkbook: TsBasicWorkbook); begin inherited Create(AWorkbook); FDateMode := XlsxSettings.DateMode; FSharedStrings := TStringList.Create; FSheetList := TFPList.Create; FFillList := TFPList.Create; FBorderList := TFPList.Create; FHyperlinkList := TFPList.Create; FCellFormatList := TsCellFormatList.Create(true); FDifferentialFormatList := TFPList.Create; // Allow duplicates because xf indexes used in cell records cannot be found any more. FSharedFormulaBaseList := TFPList.Create; FPalette := TsPalette.Create; FPointSeparatorSettings := DefaultFormatSettings; FPointSeparatorSettings.DecimalSeparator := '.'; InitOOXMLLimitations(FLimitations); end; destructor TsSpreadOOXMLReader.Destroy; var j: Integer; begin for j := FFillList.Count-1 downto 0 do TObject(FFillList[j]).Free; FFillList.Free; for j := FBorderList.Count-1 downto 0 do TObject(FBorderList[j]).Free; FBorderList.Free; for j := FHyperlinkList.Count-1 downto 0 do TObject(FHyperlinkList[j]).Free; FHyperlinkList.Free; for j := FDifferentialFormatList.Count-1 downto 0 do TObject(FDifferentialFormatList[j]).Free; FDifferentialFormatList.Free; for j := FSheetList.Count-1 downto 0 do TObject(FSheetList[j]).Free; FSheetList.Free; for j := FSharedStrings.Count-1 downto 0 do FSharedStrings.Objects[j].Free; FSharedStrings.Free; for j := FSharedFormulaBaseList.Count-1 downto 0 do TObject(FSharedFormulaBaseList[j]).Free; FSharedFormulaBaseList.Free; // FCellFormatList, FNumFormatList and FFontList are destroyed by ancestor FPalette.Free; inherited Destroy; end; {@@ ---------------------------------------------------------------------------- Adds the built-in number formats to the NumFormatList. -------------------------------------------------------------------------------} procedure TsSpreadOOXMLReader.AddBuiltinNumFormats; begin FFirstNumFormatIndexInFile := 164; AddBuiltInBiffFormats( FNumFormatList, Workbook.FormatSettings, FFirstNumFormatIndexInFile-1 ); end; procedure TsSpreadOOXMLReader.ApplyCellFormatting(ACell: PCell; XFIndex: Integer); var i: Integer; fmt: PsCellFormat; begin if Assigned(ACell) then begin i := FCellFormatList.FindIndexOfID(XFIndex); fmt := FCellFormatList.Items[i]; ACell^.FormatIndex := (FWorkbook as TsWorkbook).AddCellFormat(fmt^); end; end; procedure TsSpreadOOXMLReader.ApplyHyperlinks(AWorksheet: TsbasicWorksheet); var i: Integer; hyperlinkData: THyperlinkListData; r1, c1, r2, c2, r, c: Cardinal; sheet: TsWorksheet; begin sheet := AWorksheet as TsWorksheet; for i:=0 to FHyperlinkList.Count-1 do begin hyperlinkData := THyperlinkListData(FHyperlinkList.Items[i]); if hyperlinkData.Worksheet <> sheet then Continue; if pos(':', hyperlinkdata.CellRef) = 0 then begin ParseCellString(hyperlinkData.CellRef, r1, c1); r2 := r1; c2 := c1; end else ParseCellRangeString(hyperlinkData.CellRef, r1, c1, r2, c2); for r := r1 to r2 do for c := c1 to c2 do with hyperlinkData do if Target = '' then sheet.WriteHyperlink(r, c, '#'+TextMark, ToolTip) else if TextMark = '' then sheet.WriteHyperlink(r, c, Target, ToolTip) else sheet.WriteHyperlink(r, c, Target+'#'+TextMark, ToolTip); end; end; class function TsSpreadOOXMLReader.CheckFileFormat(AStream: TStream): Boolean; begin Result := HasZipHeader(AStream); end; function TsSpreadOOXMLReader.FindCommentsFileName(ANode: TDOMNode): String; var s: String; begin while ANode <> nil do begin s := GetAttrValue(ANode, 'Type'); if s = SCHEMAS_COMMENTS then begin Result := ExtractFileName(GetAttrValue(ANode, 'Target')); exit; end; ANode := ANode.NextSibling; end; Result := ''; end; procedure TsSpreadOOXMLReader.ReadActiveSheet(ANode: TDOMNode; out ActiveSheetIndex: Integer); var S: string; i: Integer; node: TDOMNode; begin ActiveSheetIndex := -1; if ANode = nil then Exit; node := ANode.FindNode('workbookView'); if node = nil then node := ANode.FindNode('x:workbookView'); S := GetAttrValue(node, 'activeTab'); if TryStrToInt(S, i) then ActiveSheetIndex := i; end; procedure TsSpreadOOXMLReader.ReadBorders(ANode: TDOMNode); var borderNode: TDOMNode; edgeNode: TDOMNode; nodeName: String; borders: TsCellBorders; borderStyles: TsCellBorderStyles; borderData: TBorderListData; s: String; begin if ANode = nil then exit; borderStyles := DEFAULT_BORDERSTYLES; borderNode := ANode.FirstChild; while Assigned(borderNode) do begin nodeName := borderNode.NodeName; if (nodeName = 'border') or (nodeName = 'x:border') then begin borders := []; s := GetAttrValue(borderNode, 'diagonalUp'); if strIsTrue(s) then Include(borders, cbDiagUp); s := GetAttrValue(borderNode, 'diagonalDown'); if StrIsTrue(s) then Include(borders, cbDiagDown); edgeNode := borderNode.FirstChild; while Assigned(edgeNode) do begin nodeName := edgeNode.NodeName; if (nodeName = 'left') or (nodeName = 'x:left') then begin if ReadBorderStyle(edgeNode, borderStyles[cbWest]) then Include(borders, cbWest); end else if (nodeName = 'right') or (nodeName = 'x:right') then begin if ReadBorderStyle(edgeNode, borderStyles[cbEast]) then Include(borders, cbEast); end else if (nodeName = 'top') or (nodeName = 'x:top') then begin if ReadBorderStyle(edgeNode, borderStyles[cbNorth]) then Include(borders, cbNorth); end else if (nodeName = 'bottom') or (nodename = 'x:bottom') then begin if ReadBorderStyle(edgeNode, borderStyles[cbSouth]) then Include(borders, cbSouth); end else if (nodeName = 'diagonal') or (nodeName = 'x:diagonal') then begin if ReadBorderStyle(edgeNode, borderStyles[cbDiagUp]) then borderStyles[cbDiagDown] := borderStyles[cbDiagUp]; end; edgeNode := edgeNode.NextSibling; end; // add to border list borderData := TBorderListData.Create; borderData.Borders := borders; borderData.BorderStyles := borderStyles; FBorderList.Add(borderData); end; borderNode := borderNode.NextSibling; end; end; function TsSpreadOOXMLReader.ReadBorderStyle(ANode: TDOMNode; out ABorderStyle: TsCellBorderStyle): Boolean; var s: String; colorNode: TDOMNode; nodeName: String; begin Result := false; ABorderStyle.LineStyle := lsThin; ABorderStyle.Color := scBlack; s := GetAttrValue(ANode, 'style'); if (s = '') or (s = 'none') then exit; ABorderStyle.LineStyle := StrToLineStyle(s); { if s = 'thin' then ABorderStyle.LineStyle := lsThin else if s = 'medium'then ABorderStyle.LineStyle := lsMedium else if s = 'thick' then ABorderStyle.LineStyle := lsThick else if s = 'dotted' then ABorderStyle.LineStyle := lsDotted else if s = 'dashed' then ABorderStyle.LineStyle := lsDashed else if s = 'double' then ABorderStyle.LineStyle := lsDouble else if s = 'hair' then ABorderStyle.LineStyle := lsHair else if s = 'dashDot' then ABorderStyle.LineStyle := lsDashDot else if s = 'dashDotDot' then ABorderStyle.LineStyle := lsDashDotDot else if s = 'mediumDashed' then ABorderStyle.LineStyle := lsMediumDash else if s = 'mediumDashDot' then ABorderStyle.LineSTyle := lsMediumDashDot else if s = 'mediumDashDotDot' then ABorderStyle.LineStyle := lsMediumDashDotDot else if s = 'slantDashDot' then ABorderStyle.LineStyle := lsSlantDashDot; } colorNode := ANode.FirstChild; while Assigned(colorNode) do begin nodeName := colorNode.NodeName; if (nodeName = 'color') or (nodename = 'x:color') then ABorderStyle.Color := ReadColor(colorNode); colorNode := colorNode.NextSibling; end; Result := true; end; procedure TsSpreadOOXMLReader.ReadCell(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARowIndex: Cardinal; var AColIndex: Cardinal); var book: TsWorkbook; sheet: TsWorksheet; addr, s: String; rowIndex, colIndex: Cardinal; cell: PCell; lCell: TCell; sharedFormulabase: TSharedFormulaData; datanode, tnode: TDOMNode; dataStr: String; formulaStr: String; formula: PsFormula; nodeName: String; sstIndex: Integer; number: Double; fmt: TsCellFormat; numFmt: TsNumFormatParams = nil; ms: TMemoryStream; n: Integer; begin if ANode = nil then exit; book := FWorkbook as TsWorkbook; sheet := AWorksheet as TsWorksheet; // get row and column address addr := GetAttrValue(ANode, 'r'); // cell address, like 'A1' if addr <> '' then ParseCellString(addr, rowIndex, colIndex) else begin rowIndex := ARowIndex; colIndex := AColIndex; end; AColIndex := colIndex + 1; // create cell if FIsVirtualMode then begin InitCell(FWorksheet, rowIndex, colIndex, FVirtualCell); cell := @FVirtualCell; end else cell := sheet.AddCell(rowIndex, colIndex); // get style index s := GetAttrValue(ANode, 's'); if s <> '' then begin ApplyCellFormatting(cell, StrToInt(s)); fmt := book.GetCellFormat(cell^.FormatIndex); end else begin InitFormatRecord(fmt); cell^.FormatIndex := 0; end; // get number format parameters numFmt := book.GetNumberFormat(fmt.NumberFormatIndex); // get data datanode := ANode.FirstChild; dataStr := ''; formulaStr := ''; while Assigned(datanode) do begin nodeName := datanode.NodeName; if (nodeName = 'v') or (nodeName = 'x:v') then dataStr := GetNodeValue(datanode) else if (nodeName = 'is') or (nodeName = 'x:is') then begin tnode := datanode.FirstChild; while Assigned(tnode) do begin nodename := tnode.NodeName; if (nodename = 't') or (nodeName = 'x:t') then dataStr := dataStr + GetNodeValue(tnode); tnode := tnode.NextSibling; end; end; if (boReadFormulas in book.Options) and ((nodeName = 'f') or (nodeName = 'x:f'))then begin // Formula to cell formulaStr := GetNodeValue(datanode); try s := GetAttrValue(datanode, 't'); if s = 'shared' then begin // Shared formula s := GetAttrValue(datanode, 'ref'); if (s <> '') then // This defines the shared formula range begin sheet.WriteFormula(cell, formulaStr); // We store the shared formula base in the SharedFormulaBaseList. // The list index is identical with the 'si' attribute of the node. sharedformulabase := TSharedFormulaData.Create; sharedformulabase.Worksheet := sheet; sharedformulabase.Row := rowindex; sharedformulabase.Col := colindex; sharedformulabase.Formula := formulaStr; FSharedFormulaBaseList.Add(sharedformulabase); sheet.WriteFormula(rowindex, colindex, formulaStr); end else begin // Get index into the SharedFormulaBaseList... s := GetAttrValue(datanode, 'si'); if s <> '' then begin sharedformulabase := TSharedFormulaData(FSharedFormulaBaseList[StrToInt(s)]); // ... and copy shared formula to destination cell formula := sharedFormulaBase.Worksheet.Formulas.FindFormula( sharedFormulabase.Row, sharedFormulaBase.Col); InitCell(FWorksheet, sharedformulabase.Row, sharedformulabase.Col, lCell); sheet.UseFormulaInCell(@lCell, formula); sheet.CopyFormula(@lCell, cell); end; end; end else // "Normal" formula sheet.WriteFormula(cell, formulaStr); except on E:EExprParser do begin FWorkbook.AddErrorMsg(E.Message); if (boAbortReadOnFormulaError in Workbook.Options) then raise; end; on E:ECalcEngine do begin FWorkbook.AddErrorMsg(E.Message); if (boAbortReadOnFormulaError in Workbook.Options) then raise; end; end; end; datanode := datanode.NextSibling; end; book.LockFormulas; // Protect formulas from being deleted by the WriteXXXX calls try // get data type s := GetAttrValue(ANode, 't'); // "t" = data type if (s = '') and (dataStr = '') then sheet.WriteBlank(cell, true) // true --> do not erase the formula!!! else if (s = '') or (s = 'n') then begin // Number or date/time, depending on format if TryStrToFloat(dataStr, number, FPointSeparatorSettings) then begin if IsDateTimeFormat(numFmt) then begin if not IsTimeIntervalFormat(numFmt) then // no correction of time origin for "time interval" format number := ConvertExcelDateTimeToDateTime(number, FDateMode); sheet.WriteDateTime(cell, number); end else if IsTextFormat(numFmt) then sheet.WriteText(cell, dataStr) else sheet.WriteNumber(cell, number); end else workbook.AddErrorMsg( 'Error reading cell %s: Failure to convert "%s" to number.', [ GetCellString(rowindex, colindex), dataStr ]); end else if s = 's' then begin // String from shared strings table if TryStrToInt(dataStr, sstIndex) then begin sheet.WriteText(cell, FSharedStrings[sstIndex]); // Read rich-text parameters from the stream stored in the Objects of the stringlist if FSharedStrings.Objects[sstIndex] <> nil then begin ms := TMemoryStream(FSharedStrings.Objects[sstIndex]); ms.Position := 0; n := ms.ReadWord; // Count of array elements SetLength(cell^.RichTextParams, n); ms.ReadBuffer(cell^.RichTextParams[0], n*SizeOf(TsRichTextParam)); end; end else workbook.AddErrorMsg( 'Error readind cell %s: Failure to extract SST index from value "%s"', [ GetCellString(rowindex, colindex), dataStr ]); end else if (s = 'str') or (s = 'inlineStr') then begin // literal string sheet.WriteText(cell, datastr); end else if s = 'b' then // boolean sheet.WriteBoolValue(cell, dataStr='1') else if s = 'e' then begin // error value if dataStr = '#NULL!' then sheet.WriteErrorValue(cell, errEmptyIntersection) else if dataStr = '#DIV/0!' then sheet.WriteErrorValue(cell, errDivideByZero) else if dataStr = '#VALUE!' then sheet.WriteErrorValue(cell, errWrongType) else if dataStr = '#REF!' then sheet.WriteErrorValue(cell, errIllegalRef) else if dataStr = '#NAME?' then sheet.WriteErrorValue(cell, errWrongName) else if dataStr = '#NUM!' then sheet.WriteErrorValue(cell, errOverflow) else if dataStr = '#N/A' then sheet.WriteErrorValue(cell, errArgError) else if dataStr = '' then // rare case... // see http://forum.lazarus.freepascal.org/index.php/topic,38726.0.html sheet.WriteBlank(cell) else raise EFPSpreadsheetReader.Create(rsUnknownErrorType); end else raise EFPSpreadsheetReader.Create(rsUnknownDataType); if FIsVirtualMode then book.OnReadCellData(book, rowIndex, colIndex, cell); finally book.UnlockFormulas; end; end; procedure TsSpreadOOXMLReader.ReadCellXfs(ANode: TDOMNode); var node: TDOMNode; childNode: TDOMNode; nodeName: String; fmt: TsCellFormat; fs: TsFillStyle; s1, s2: String; numFmtIndex, fillIndex, borderIndex: Integer; numFmtStr: String; numFmtParams: TsNumFormatParams; fillData: TFillListData; borderData: TBorderListData; fnt: TsFont; cp: TsCellProtections; book: TsWorkbook; begin if ANode = nil then exit; book := FWorkbook as TsWorkbook; node := ANode.FirstChild; while Assigned(node) do begin nodeName := node.NodeName; if (nodeName = 'xf') or (nodeName = 'x:xf') then begin InitFormatRecord(fmt); fmt.ID := FCellFormatList.Count; fmt.Name := ''; // strange: sometimes the "apply*" are missing. Therefore, it may be better // to check against "<>0" instead of "=1" s1 := GetAttrValue(node, 'numFmtId'); s2 := GetAttrValue(node, 'applyNumberFormat'); if (s1 <> '') and not StrIsFalse(s2) then //(s2 <> '0') and (s2 <> 'false') then begin numFmtIndex := StrToInt(s1); numFmtStr := NumFormatList[numFmtIndex]; if SameText(numFmtStr, 'General') then numFmtParams := nil else begin fmt.NumberFormatIndex := book.AddNumberFormat(numFmtStr); numFmtParams := book.GetNumberFormat(fmt.NumberFormatIndex); end; if numFmtParams <> nil then begin fmt.NumberFormat := numFmtParams.NumFormat; fmt.NumberFormatStr := numFmtStr; Include(fmt.UsedFormattingFields, uffNumberFormat); end else begin fmt.NumberFormat := nfGeneral; fmt.NumberFormatStr := ''; Exclude(fmt.UsedFormattingFields, uffNumberFormat); end; end; s1 := GetAttrValue(node, 'fontId'); s2 := Lowercase(GetAttrValue(node, 'applyFont')); if (s1 <> '') and not StrIsFalse(s2) then //(s2 <> '0') and (s2 <> 'false') then begin fnt := TsFont(FFontList.Items[StrToInt(s1)]); fmt.FontIndex := book.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position); if fmt.FontIndex = -1 then fmt.FontIndex := book.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position); if fmt.FontIndex > 0 then Include(fmt.UsedFormattingFields, uffFont); end; s1 := GetAttrValue(node, 'fillId'); s2 := Lowercase(GetAttrValue(node, 'applyFill')); if (s1 <> '') and not StrIsFalse(s2) then //(s2 <> '0') and (s2 <> 'false') then begin fillIndex := StrToInt(s1); fillData := TFillListData(FFillList[fillIndex]); if (fillData <> nil) and (fillData.PatternType <> 'none') then begin fmt.Background.FgColor := fillData.FgColor; fmt.Background.BgColor := fillData.BgColor; for fs in TsFillStyle do if SameText(fillData.PatternType, PATTERN_TYPES[fs]) then begin fmt.Background.Style := fs; Include(fmt.UsedFormattingFields, uffBackground); break; end; end; end; s1 := GetAttrValue(node, 'borderId'); s2 := Lowercase(GetAttrValue(node, 'applyBorder')); if (s1 <> '') and not StrIsFalse(s2) then //(s2 <> '0') and (s2 <> 'false') then begin borderIndex := StrToInt(s1); borderData := TBorderListData(FBorderList[borderIndex]); if (borderData <> nil) then begin fmt.BorderStyles := borderData.BorderStyles; fmt.Border := borderData.Borders; end; end; s2 := Lowercase(GetAttrValue(node, 'applyAlignment')); if StrIsTrue(s2) then // if (s2 <> '0') and (s2 <> '') and (s2 <> 'false') then begin childNode := node.FirstChild; while Assigned(childNode) do begin nodeName := childNode.NodeName; if (nodeName = 'alignment') or (nodeName = 'x:alignment') then begin s1 := GetAttrValue(childNode, 'horizontal'); if s1 = 'left' then fmt.HorAlignment := haLeft else if s1 = 'center' then fmt.HorAlignment := haCenter else if s1 = 'right' then fmt.HorAlignment := haRight; s1 := GetAttrValue(childNode, 'vertical'); if s1 = 'top' then fmt.VertAlignment := vaTop else if s1 = 'center' then fmt.VertAlignment := vaCenter else if s1 = 'bottom' then fmt.VertAlignment := vaBottom; s1 := GetAttrValue(childNode, 'readingOrder'); if (s1 = '1') or (s1 = '2') then fmt.BiDiMode := TsBiDiMode(StrToInt(s1)); s1 := GetAttrValue(childNode, 'wrapText'); if StrIsTrue(s1) then //(s1 <> '') and (s1 <> '0') and (s1 <> 'false') then Include(fmt.UsedFormattingFields, uffWordWrap); s1 := GetAttrValue(childNode, 'textRotation'); if s1 = '90' then fmt.TextRotation := rt90DegreeCounterClockwiseRotation else if s1 = '180' then fmt.TextRotation := rt90DegreeClockwiseRotation else if s1 = '255' then fmt.TextRotation := rtStacked else fmt.TextRotation := trHorizontal; end; childNode := childNode.NextSibling; end; end; // protection s2 := Lowercase(GetAttrValue(node, 'applyProtection')); if StrIsTrue(s2) then //(s2 <> '0') and (s2 <> '') and (s2 <> 'false') then begin cp := [cpLockCell]; childNode := node.FirstChild; while Assigned(childNode) do begin nodeName := childNode.NodeName; if (nodeName = 'protection') or (nodeName = 'x:protection') then begin s1 := GetAttrValue(childNode, 'locked'); if StrIsFalse(s1) then Exclude(cp, cpLockCell); s1 := GetAttrValue(childNode, 'hidden'); if StrIsTrue(s1) then Include(cp, cpHideFormulas); end; childNode := childNode.NextSibling; end; fmt.Protection := cp; end; if fmt.FontIndex > 0 then Include(fmt.UsedFormattingFields, uffFont); if fmt.Border <> [] then Include(fmt.UsedFormattingFields, uffBorder); if fmt.HorAlignment <> haDefault then Include(fmt.UsedFormattingFields, uffHorAlign); if fmt.VertAlignment <> vaDefault then Include(fmt.UsedFormattingFields, uffVertAlign); if fmt.TextRotation <> trHorizontal then Include(fmt.UsedFormattingFields, uffTextRotation); if fmt.BiDiMode <> bdDefault then Include(fmt.UsedFormattingFields, uffBiDi); if fmt.Protection <> DEFAULT_CELL_PROTECTION then Include(fmt.UsedFormattingFields, uffProtection); FCellFormatList.Add(fmt); end; node := node.NextSibling; end; end; procedure TsSpreadOOXMLReader.ReadCFAverage(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARange: TsCellRange; AFormatIndex: Integer); var sStdDev, sEquAve, sAboveAve: String; condition: TsCFCondition; stdDev: Double; sheet: TsWorksheet; begin sheet := TsWorksheet(AWorksheet); sEquAve := GetAttrValue(ANode, 'equalAverage'); sAboveAve := GetAttrValue(ANode, 'aboveAverage'); if (sEquAve='1') then begin if (sAboveAve='0') then condition := cfcBelowEqualAverage else condition := cfcAboveEqualAverage; end else begin if (sAboveAve = '0') then condition := cfcBelowAverage else condition := cfcAboveAverage; end; sStdDev := GetAttrValue(ANode, 'stdDev'); if not TryStrToFloat(sStdDev, stdDev, FPointSeparatorSettings) then sStdDev := ''; // This will omit the "stdDev" attribute if sStdDev = '' then sheet.WriteConditionalCellFormat(ARange, condition, AFormatIndex) else sheet.WriteConditionalCellFormat(ARange, condition, stdDev, AFormatIndex); end; procedure TsSpreadOOXMLReader.ReadCFCellFormat(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARange: TsCellRange; AFormatIndex: Integer); var nodeName: String; sOp: String; sFormula: Array of String = nil; cf: TsCFCondition; found: Boolean; i: Integer; n: Integer; x: Double; r, c: Cardinal; condition: TsCFCondition; values: array of Variant = nil; sheet: TsWorksheet; begin sheet := TsWorksheet(AWorksheet); sOp := GetAttrValue(ANode, 'operator'); found := false; for cf in TsCFCondition do if sOp = CF_OPERATOR_NAMES[cf] then begin found := true; condition := cf; break; end; if (not found) or not (condition in [cfcEqual..cfcNotBetween]) then exit; // Process cases related to (un)equality of cells SetLength(sFormula, 0); ANode := ANode.FirstChild; while (ANode <> nil) do begin nodeName := ANode.NodeName; if nodeName = 'formula' then begin SetLength(sFormula, Length(sFormula) + 1); sFormula[High(sFormula)] := GetNodeValue(ANode); end; ANode := ANode.NextSibling; end; SetLength(values, Length(sFormula)); for i := 0 to High(sFormula) do begin values[i] := sFormula[i]; if (sFormula[i] <> '') then begin if TryStrToInt(sFormula[i], n) then values[i] := n else if TryStrToFloat(sFormula[i], x, FPointSeparatorSettings) then values[i] := x else if sFormula[i][1] = '"' then values[i] := sFormula[i] else if ParseCellString(sFormula[i], r, c) then values[i] := sFormula[i] else values[i] := '=' + sFormula[i]; end; end; case Length(values) of 0: sheet.WriteConditionalCellFormat(ARange, condition, AFormatIndex); 1: sheet.WriteConditionalCellFormat(ARange, condition, values[0], AFormatIndex); 2: sheet.WriteConditionalCellFormat(ARange, condition, values[0], values[1], AFormatIndex); end; end; procedure TsSpreadOOXMLReader.ReadCFColorRange(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARange: TsCellRange); { } var sheet: TsWorksheet; nodeName, s: String; vk: array[0..2] of TsCFValueKind = (vkNone, vkNone, vkNone); v: array[0..2] of Double = (NaN, NaN, NaN); c: array[0..2] of TsColor = (scNotDefined, scNotDefined, scNotDefined); x: Double; iv, ic: Integer; clevels, vlevels: Integer; begin iv := 0; ic := 0; ANode := ANode.FirstChild; if (ANode <> nil) and (ANode.NodeName = 'colorScale') then ANode := ANode.FirstChild; while (ANode <> nil) do begin nodeName := ANode.NodeName; if (nodeName = 'color') and (ic <= High(c)) then begin c[ic] := ReadColor(ANode); inc(ic); end; if (nodeName = 'cfvo') and (iv <= High(vk)) then begin s := GetAttrValue(ANode, 'type'); vk[iv] := StrToCFValueKind(s); s := GetAttrValue(ANode, 'val'); if TryStrToFloat(s, x, FPointSeparatorSettings) then v[iv] := x else v[iv] := 0.0; inc(iv); end; ANode := ANode.NextSibling; end; clevels := 0; for ic := 0 to High(c) do begin if c[ic] = scNotDefined then break; inc(cLevels); end; vlevels := 0; for iv := 0 to High(vk) do begin if vk[iv] = vkNone then break; inc(vlevels); end; // Not 100% sure, but I guess there must be as many colors as value kinds. if vlevels <> cLevels then begin FWorkbook.AddErrorMsg('ColorRange: colors-levels mismatch'); exit; end; sheet := TsWorksheet(AWorksheet); case clevels of 1: exit; 2: sheet.WriteColorRange(ARange, c[0],vk[0],v[0], c[1],vk[1],v[1]); 3: sheet.WriteColorRange(ARange, c[0],vk[0],v[0], c[1],vk[1],v[1], c[2],vk[2],v[2]); end; end; procedure TsSpreadOOXMLReader.ReadCFDataBars(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARange: TsCelLRange); { } // We do not support the x14 namespace extension ATM var sheet: TsWorksheet; nodeName, s: String; vk: array[0..1] of TsCFValuekind; v: array[0..1] of Double; x: Double; idx: Integer; clr: TsColor; begin idx := 0; ANode := ANode.FirstChild; if (ANode <> nil) and (ANode.NodeName = 'dataBar') then ANode := ANode.FirstChild; while ANode <> nil do begin nodeName := ANode.NodeName; if nodeName = 'color' then clr := ReadColor(ANode) else clr := scBlue; if (nodeName = 'cfvo') and (idx <= 1) then begin s := GetAttrValue(ANode, 'type'); vk[idx] := StrToCFValueKind(s); s := GetAttrValue(ANode, 'val'); if TryStrToFloat(s, x, FPointSeparatorSettings) then v[idx] := x else v[idx] := NaN; inc(idx); end; ANode := ANode.NextSibling; end; // Check for value attribute. If not existing, use simple min/max scaling and log error. if ((vk[0] in [vkPercent, vkPercentile, vkValue]) and IsNaN(v[0])) or ((vk[1] in [vkPercent, vkPercentile, vkValue]) and IsNaN(v[1])) then begin FWorkbook.AddErrorMsg('DataBars: value needed.'); vk[0] := vkMin; vk[1] := vkMax; end; sheet := TsWorksheet(AWorksheet); sheet.WriteDataBars(ARange, clr, vk[0], v[0], vk[1], v[1]); end; procedure TsSpreadOOXMLReader.ReadCFDateFormat(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARange: TsCellRange; AFormatIndex: Integer); var sheet: TsWorksheet; s: String; cond: TsCFCondition; begin if ANode = nil then exit; sheet := TsWorksheet(AWorksheet); s := GetAttrValue(ANode, 'timePeriod'); for cond in [cfcYesterday..cfcNextMonth] do if CF_OPERATOR_NAMES[cond] = s then begin sheet.WriteConditionalCellFormat(ARange, cond, AFormatIndex); exit; end; end; procedure TsSpreadOOXMLReader.ReadCFExpression(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARange: TsCellRange; AFormatIndex: Integer); var sheet: TsWorksheet; nodeName: String; s, s1: String; c: TsCFCondition; firstCellInRange: String; begin sheet := TsWorksheet(AWorksheet); firstCellInRange := GetCellString(ARange.Row1, ARange.Col1); ANode := ANode.FirstChild; while ANode <> nil do begin nodeName := ANode.NodeName; if nodeName = 'formula' then begin s := GetNodeValue(ANode); for c in [cfcLastYear..cfcNextYear] do begin s1 := Format(CF_YEAR_FORMULAS[c], [firstCellInRange]); if s1 = s then begin sheet.WriteConditionalCellFormat(ARange, c, AFormatIndex); exit; end; end; sheet.WriteConditionalCellFormat(ARange, cfcExpression, s, AFormatIndex); exit; end; ANode := ANode.NextSibling; end; end; procedure TsSpreadOOXMLReader.ReadCFIconSet(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARange: TsCellRange); var sheet: TsWorksheet; s: String; sIconSet: String; iconSet: TsCFIconSet; found: Boolean; tmpIconSet: TsCFIconSet; nodeName: String; iv: Integer; vk: array of TsCFValueKind = nil; v: array of Double = nil; n: Integer; x: Double; res: Integer; begin ANode := ANode.FirstChild; if (ANode <> nil) and (ANode.NodeName = 'iconSet') then begin sIconSet := GetAttrValue(ANode, 'iconSet'); found := false; for tmpIconSet in TsCFIconSet do if 'is' + sIconSet = GetEnumName(typeInfo(TsCFIconSet), integer(tmpIconSet)) then begin iconSet := tmpIconSet; found := true; break; end; if (not found) or (sIconSet = '') then Exit; // Determine icon count from name of icon set n := GetCFIconCount(iconSet); if (n < 3) or (n > 5) then // only 3, 4 or 5 icons allowed Exit; SetLength(v, n); SetLength(vk, n); iv := 0; ANode := ANode.FirstChild; while (ANode <> nil) do begin nodeName := ANode.NodeName; if (nodeName = 'cfvo') and (iv <= High(vk)) then begin s := GetAttrValue(ANode, 'type'); vk[iv] := StrToCFValueKind(s); s := GetAttrValue(ANode, 'val'); if TryStrToFloat(s, x, FPointSeparatorSettings) then v[iv] := x else v[iv] := 0.0; inc(iv); if iv >= n then break; end; ANode := ANode.NextSibling; end; sheet := TsWorksheet(AWorksheet); // Ignore the first value because it is always 0 case n of 3: res := sheet.WriteIconSet(ARange, iconSet, vk[1], v[1], vk[2], v[2]); 4: res := sheet.WriteIconSet(ARange, iconSet, vk[1], v[1], vk[2], v[2], vk[3], v[3]); 5: res := sheet.WriteIconSet(ARange, iconSet, vk[1], v[1], vk[2], v[2], vk[3], v[3], vk[4], v[4]); end; ANode := ANode.NextSibling; end; end; procedure TsSpreadOOXMLReader.ReadCFMisc(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARange: TsCellRange; AFormatIndex: Integer); var sheet: TsWorksheet; s: String; cf, condition: TsCFCondition; found: Boolean; begin sheet := TsWorksheet(AWorksheet); found := false; s := GetAttrValue(ANode, 'type'); for cf in TsCFCondition do if CF_TYPE_NAMES[cf] = s then begin condition := cf; found := true; break; end; if not found then exit; if condition in [cfcBeginsWith..cfcNotContainsText] then begin s := GetAttrValue(ANode, 'text'); sheet. WriteConditionalCellFormat(ARange, condition, s, AFormatIndex); end else sheet. WriteConditionalCellFormat(ARange, condition, AFormatIndex); end; procedure TsSpreadOOXMLReader.ReadCFTop10(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARange: TsCellRange; AFormatIndex: Integer); var sheet: TsWorksheet; rank: Integer; s, sPercent, sBottom: String; condition: TsCFCondition; begin sheet := TsWorksheet(AWorksheet); s := GetAttrValue(ANode, 'rank'); if not TryStrToInt(s, rank) then rank := 10; sPercent := GetAttrValue(ANode, 'percent'); sBottom := GetAttrValue(ANode, 'bottom'); if (sBottom = '1') then begin if sPercent = '1' then condition := cfcBottomPercent else condition := cfcBottom; end else begin if sPercent = '1' then condition := cfcTopPercent else condition := cfcTop; end; sheet.WriteConditionalCellFormat(ARange, condition, rank, AFormatIndex); end; procedure TsSpreadOOXMLReader.ReadColRowBreaks(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var s: String; sheet: TsWorksheet absolute AWorksheet; node: TDOMNode; nodeName: String; n: Integer; isCol: Boolean; begin if (ANode = nil) or (AWorksheet = nil) then // just to make sure... exit; nodeName := ANode.NodeName; isCol := nodeName = 'colBreaks'; node := ANode.FirstChild; while node <> nil do begin nodeName := node.NodeName; if nodeName = 'brk' then begin s := GetAttrValue(node, 'id'); if (s <> '') and TryStrToInt(s, n) then begin s := GetAttrValue(node, 'man'); if s = '1' then begin if isCol then sheet.AddPageBreakToCol(n) else sheet.AddPageBreakToRow(n); end; end; end; node := node.NextSibling; end; end; function TsSpreadOOXMLReader.ReadColor(ANode: TDOMNode): TsColor; var s: String; rgb: TsColor; idx: Integer; tint: Double; n, i: Integer; nodename: String; begin Result := scNotDefined; Assert(ANode <> nil); s := Lowercase(GetAttrValue(ANode, 'auto')); if (s = '1') or (s = 'true') then begin nodename := ANode.NodeName; if (nodeName = 'fgColor') or (nodename = 'x:fgColor') then Result := scBlack else Result := scTransparent; exit; end; s := GetAttrValue(ANode, 'rgb'); if s <> '' then begin if s[1] = '#' then Result := HTMLColorStrToColor(s) else Result := HTMLColorStrToColor('#' + s); exit; end; s := GetAttrValue(ANode, 'indexed'); if s <> '' then begin i := StrToInt(s); n := FPalette.Count; if (i <= LAST_PALETTE_INDEX) and (i < n) then begin Result := FPalette[i]; exit; end; // System colors // taken from OpenOffice docs case i of $0040: Result := scBlack; // Default border color $0041: Result := scWhite; // Default background color $0043: Result := scGray; // Dialog background color $004D: Result := scBlack; // Text color, chart border lines $004E: Result := scGray; // Background color for chart areas $004F: Result := scBlack; // Automatic color for chart border lines $0050: Result := scBlack; // ??? $0051: Result := scBlack; // ?? $7FFF: Result := scBlack; // Automatic text color else Result := scBlack; end; exit; end; s := GetAttrValue(ANode, 'theme'); if s <> '' then begin idx := StrToInt(s); if idx < Length(FThemeColors) then begin // For some reason the first two pairs of colors are interchanged in Excel! case idx of 0: idx := 1; 1: idx := 0; 2: idx := 3; 3: idx := 2; end; rgb := FThemeColors[idx]; s := GetAttrValue(ANode, 'tint'); if s <> '' then begin tint := StrToFloat(s, FPointSeparatorSettings); rgb := TintedColor(rgb, tint); end; Result := rgb; exit; end; end; Result := scBlack; end; procedure TsSpreadOOXMLReader.ReadCols(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); const EPS = 1e-3; var colNode: TDOMNode; col, col1, col2: Cardinal; // column indexes lCol: TCol; // column record w: Double; s: String; nodeName: String; idx: Integer; fmt: PsCellFormat; book: TsWorkbook; sheet: TsWorksheet; begin if ANode = nil then exit; book := FWorkbook as TsWorkbook; sheet := AWorksheet as TsWorksheet; colNode := ANode.FirstChild; while Assigned(colNode) do begin nodeName := colNode.NodeName; if (nodename = 'col') or (nodeName = 'x:col') then begin s := GetAttrValue(colNode, 'min'); if s <> '' then col1 := StrToInt(s)-1 else col1 := 0; s := GetAttrValue(colNode, 'max'); if s <> '' then col2 := StrToInt(s)-1 else col2 := col1; s := GetAttrValue(colNode, 'customWidth'); if StrIsTrue(s) then //(s = '1') or (s = 'true') then begin s := GetAttrValue(colNode, 'width'); if (s <> '') and TryStrToFloat(s, w, FPointSeparatorSettings) then begin if SameValue(w, sheet.ReadDefaultColWidth(suChars), EPS) then // is this needed? lCol.ColWidthType := cwtDefault else lCol.ColWidthType := cwtCustom; lCol.Width := book.ConvertUnits(w, suChars, book.Units); end; end else begin lCol.ColWidthType := cwtDefault; lCol.Width := sheet.ReadDefaultColWidth(FWorkbook.Units); end; s := GetAttrValue(colNode, 'style'); if s <> '' then begin idx := FCellFormatList.FindIndexOfID(StrToInt(s)); fmt := FCellFormatList.Items[idx]; lCol.FormatIndex := book.AddCellFormat(fmt^); end else lCol.FormatIndex := 0; lCol.Options := []; s := GetAttrValue(colNode, 'hidden'); if StrIsTrue(s) then Include(lCol.Options, croHidden); if (lCol.ColWidthType = cwtCustom) or (lCol.FormatIndex > 0) or (lCol.Options <> []) then for col := col1 to Min(col2, FLastCol) do sheet.WriteColInfo(col, lCol); end; colNode := colNode.NextSibling; end; end; procedure TsSpreadOOXMLReader.ReadComments(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var node, txtNode, rNode, rchild: TDOMNode; nodeName: String; cellAddr: String; s: String; r, c: Cardinal; comment: String; begin comment := ''; node := ANode.FirstChild; while node <> nil do begin nodeName := node.NodeName; cellAddr := GetAttrValue(node, 'ref'); if cellAddr <> '' then begin comment := ''; txtNode := node.FirstChild; while txtNode <> nil do begin rNode := txtnode.FirstChild; while rNode <> nil do begin nodeName := rnode.NodeName; rchild := rNode.FirstChild; while rchild <> nil do begin nodename := rchild.NodeName; if (nodename = 't') or (nodename = 'x:t') then begin s := GetNodeValue(rchild); if comment = '' then comment := s else comment := comment + s; end; rchild := rchild.NextSibling; end; rNode := rNode.NextSibling; end; if (comment <> '') and ParseCellString(cellAddr, r, c) then begin // Fix line endings // #10 --> "LineEnding" comment := UTF8StringReplace(comment, #10, LineEnding, [rfReplaceAll]); (AWorksheet as TsWorksheet).WriteComment(r, c, comment); end; txtNode := txtNode.NextSibling; end; end; node := node.NextSibling; end; end; procedure TsSpreadOOXMLReader.ReadConditionalFormatting(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var childNode: TDOMNode; nodeName: string; range: TsCellRange; s: String; dxf: TDifferentialFormatData; dxfId: Integer; fmtIdx: Integer; begin while ANode <> nil do begin nodeName := ANode.NodeName; if (nodeName = 'conditionalFormatting') then begin s := GetAttrValue(ANode, 'sqref'); if ParseCellRangeString(s, range) then begin childNode := ANode.FirstChild; while childNode <> nil do begin nodeName := childNode.NodeName; if nodeName = 'cfRule' then begin // Get format index s := GetAttrValue(childNode, 'dxfId'); if TryStrToInt(s, dxfId) then begin dxf := TDifferentialFormatData(FDifferentialFormatList[dxfId]); fmtIdx := dxf.CellFormatIndex; end else fmtIdx := 0; s := GetAttrValue(childNode, 'type'); case s of 'cellIs': ReadCFCellFormat(childNode, AWorksheet, range, fmtIdx); 'aboveAverage': ReadCFAverage(childNode, AWorksheet, range, fmtIdx); 'top10': ReadCFTop10(childNode, AWorksheet, range, fmtIdx); 'uniqueValues', 'duplicateValues', 'containsErrors', 'notContainsErrors': ReadCFMisc(childNode, AWorksheet, range, fmtIdx); 'containsText', 'notContainsText', 'beginsWith', 'endsWith': ReadCFMisc(childNode, AWorksheet, range, fmtIdx); 'timePeriod': ReadCFDateFormat(childNode, AWorksheet, range, fmtIdx); 'expression': ReadCFExpression(childNode, AWorksheet, range, fmtIdx); 'colorScale': ReadCFColorRange(childNode, AWorksheet, range); 'dataBar': ReadCFDataBars(childNode, AWorksheet, range); 'iconSet': ReadCFIconSet(childNode, AWorksheet, range); end; end; childNode := childNode.NextSibling; end; end; end; ANode := ANode.NextSibling; end; end; procedure TsSpreadOOXMLReader.ReadDateMode(ANode: TDOMNode); var s: String; begin if Assigned(ANode) then begin s := Lowercase(GetAttrValue(ANode, 'date1904')); if StrIsTrue(s) then // (s = '1') or (s = 'true') then FDateMode := dm1904 end; end; procedure TsSpreadOOXMLReader.ReadDefinedNames(ANode: TDOMNode); var node: TDOMNode; nodeName: String; r1,c1,r2,c2: Cardinal; id, j, p: Integer; sheet: TsWorksheet; localSheetID: String; namestr: String; s, sheetname: String; L: TStringList; begin if ANode = nil then exit; node := ANode.FirstChild; while node <> nil do begin nodename := node.NodeName; if (nodename = 'definedName') or (nodename = 'x:definedName') then begin id := -1; sheet := nil; localSheetID := GetAttrValue(node, 'localSheetId'); if (localSheetID <> '') then begin if not TryStrToInt(localSheetID, id) then begin FWorkbook.AddErrorMsg('Invalid localSheetID in "definedName" node'); node := node.NextSibling; Continue; end; sheet := (FWorkbook as TsWorkbook).GetWorksheetByIndex(id); end; namestr := GetAttrValue(node, 'name'); if namestr = '_xlnm.Print_Area' then begin if sheet = nil then begin FWorkbook.AddErrorMsg('No localSheetID found for defined name "_xlnm.Print_Area"'); continue; end; L := TStringList.Create; try L.Delimiter := ','; L.StrictDelimiter := true; L.DelimitedText := GetNodeValue(node); for j:=0 to L.Count-1 do begin s := StringReplace(L[j], '''', '', [rfReplaceAll]); p := pos(':', s); if p = 0 then begin FWorkbook.AddErrorMsg('invalid cell range reference in "definedName" node'); break; end; ParseSheetCellString(Copy(s, 1, p-1), sheetname, r1, c1); ParseSheetCellString(Copy(s, p+1, MaxInt), sheetname, r2, c2); sheet.PageLayout.AddPrintRange(r1, c1, r2, c2); end; finally L.Free; end; end else if nameStr = '_xlnm.Print_Titles' then begin if sheet = nil then begin FWorkbook.AddErrorMsg('No localSheetID found for defined name "_xlnm.Print_Titles"'); continue; end; L := TStringList.Create; try L.Delimiter := ','; L.StrictDelimiter := true; L.DelimitedText := GetNodeValue(node); for j:=0 to L.Count-1 do begin //s := ReplaceStr(L[j], '''', ''); // wp: replaced by next line due to Laz 1.0 s := StringReplace(L[j], '''', '', [rfReplaceAll]); p := pos('!', s); if p > 0 then s := Copy(s, p+1, MaxInt); p := pos(':', s); if not ParseCellColString(copy(s, 1, p-1), c1) then c1 := UNASSIGNED_ROW_COL_INDEX; if not ParseCellColString(copy(s, p+1, MaxInt), c2) then c2 := UNASSIGNED_ROW_COL_INDEX; if not ParseCellRowString(copy(s, 1, p-1), r1) then r1 := UNASSIGNED_ROW_COL_INDEX; if not ParseCellRowString(copy(s, p+1, MaxInt), r2) then r2 := UNASSIGNED_ROW_COL_INDEX; if (r1 <> cardinal(UNASSIGNED_ROW_COL_INDEX)) then sheet.PageLayout.SetRepeatedRows(r1, r2); if (c1 <> cardinal(UNASSIGNED_ROW_COL_INDEX)) then sheet.PageLayout.SetRepeatedCols(c1, c2); end; finally L.Free; end; end; end; node := node.NextSibling; end; end; procedure TsSpreadOOXMLReader.ReadDifferentialFormat(ANode: TDOMNode); var nodeName: String; childNode: TDOMNode; pattNode: TDOMNode; fontStyles: TsFontStyles; fontColor: TsColor; bgColor: TsColor; fgColor: TsColor; fillPatt: String; borders: TsCellBorders; borderStyles: TsCellBorderStyles; uff: TsUsedFormattingFields; dxf: TDifferentialFormatData; fmt: TsCellFormat; numFmtStr: String; numFmtParams: TsNumFormatParams; begin uff := []; borders := []; fontStyles := []; fontColor := scNotDefined; numFmtStr := ''; ANode := ANode.FirstChild; while ANode <> nil do begin nodeName := ANode.NodeName; if nodeName = 'font' then begin // read font uff := uff + [uffFont]; childNode := ANode.FirstChild; while childNode <> nil do begin nodeName := childNode.NodeName; if (nodename = 'b') then fontStyles := fontStyles + [fssBold] else if (nodename = 'i') then fontStyles := fontStyles + [fssItalic] else if (nodeName = 'strike') then fontStyles := fontStyles + [fssStrikeOut] else if (nodename = 'color') then fontColor := ReadColor(childNode); childNode := childNode.NextSibling; end; end else if nodeName = 'border' then begin // read border uff := uff + [uffBorder]; childNode := ANode.FirstChild; while childNode <> nil do begin nodeName := childNode.NodeName; case nodeName of 'left': if ReadBorderStyle(childNode, borderStyles[cbWest]) then Include(borders, cbWest); 'right': if ReadBorderStyle(childNode, borderStyles[cbEast]) then Include(borders, cbEast); 'top': if ReadBorderStyle(childNode, borderStyles[cbNorth]) then Include(borders, cbNorth); 'bottom': if ReadBorderStyle(childNode, borderStyles[cbSouth]) then Include(borders, cbSouth); end; childNode := childNode.NextSibling; end; end else if nodeName = 'fill' then begin // read fill uff := uff + [uffBackground]; pattNode := ANode.FirstChild; while pattNode <> nil do begin nodeName := pattNode.NodeName; if nodeName = 'patternFill' then begin fillPatt := GetAttrValue(pattNode, 'patternType'); childNode := pattNode.FirstChild; while childNode <> nil do begin nodeName := childNode.NodeName; if nodeName = 'bgColor' then bgColor := ReadColor(childNode) else if nodeName = 'fgColor' then fgColor := ReadColor(childNode); childNode := childNode.NextSibling; end; end; pattNode := pattNode.NextSibling; end; end else if nodeName = 'numFmt' then begin // Nuzmber format uff := uff + [uffNumberFormat]; numFmtStr := GetAttrValue(ANode, 'formatCode'); end; ANode := ANode.NextSibling; end; InitFormatRecord(fmt); if uff <> [] then begin dxf := TDifferentialFormatData.Create; dxf.UsedFormattingFields := uff; fmt.UsedFormattingFields := uff; if (uffBackground in uff) then begin dxf.FillPatternType := StrToFillStyle(fillPatt); dxf.FillBgColor := bgColor; dxf.FillFgColor := fgColor; fmt.SetBackground(dxf.FillPatternType, dxf.FillFgColor, dxf.FillBgColor); end; if (uffBorder in uff) then begin dxf.Borders := borders; dxf.BorderStyles := borderStyles; fmt.Border := borders; fmt.BorderStyles := borderStyles; end; if (uffFont in uff) then begin dxf.FontColor := fontColor; dxf.FontStyles := fontStyles; fmt.FontIndex := TsWorkbook(FWorkbook).AddFont('', -1, fontStyles, fontColor); // Excel does not allow to change font name and font size. end else if (uffNumberFormat in uff) then begin fmt.NumberFormatIndex := TsWorkbook(FWorkbook).AddNumberFormat(numFmtStr); numFmtParams := TsWorkbook(FWorkbook).GetNumberFormat(fmt.NumberFormatIndex); fmt.NumberFormatStr := numFmtParams.NumFormatStr; fmt.NumberFormat := numFmtParams.NumFormat; end; dxf.CellFormatIndex := TsWorkbook(FWorkbook).AddCellFormat(fmt); FDifferentialFormatList.Add(dxf); end; end; procedure TsSpreadOOXMLReader.ReadDifferentialFormats(ANode: TDOMNode); var nodeName: String; begin if ANode = nil then exit; ANode := ANode.FirstChild; while ANode <> nil do begin nodeName := ANode.NodeName; if nodeName = 'dxf' then ReadDifferentialFormat(ANode); ANode := ANode.NextSibling; end; end; procedure TsSpreadOOXMLReader.ReadDimension(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var ref: String; r1, c1: Cardinal; ok: Boolean; begin Unused(AWorksheet); FLastRow := MaxInt; FLastCol := MaxInt; if ANode = nil then exit; ref := GetAttrValue(ANode, 'ref'); if ref <> '' then begin // Normally the range of worksheets is specified as, e.g., 'A1:K5' ok := ParseCellRangeString(ref, r1, c1, FLastRow, FLastCol); // But for empty worksheets it is specified as only 'A1' if not ok then ParseCellString(ref, FLastRow, FLastCol); end; end; procedure TsSpreadOOXMLReader.ReadFileVersion(ANode: TDOMNode); begin FWrittenByFPS := GetAttrValue(ANode, 'appName') = 'fpspreadsheet'; end; procedure TsSpreadOOXMLReader.ReadFills(ANode: TDOMNode); var fillNode, patternNode, colorNode, stopNode: TDOMNode; nodeName: String; filldata: TFillListData; patt: String; fgclr: TsColor; bgclr: TsColor; begin if ANode = nil then exit; fillNode := ANode.FirstChild; while Assigned(fillNode) do begin nodename := fillNode.NodeName; patternNode := fillNode.FirstChild; while Assigned(patternNode) do begin nodename := patternNode.NodeName; if (nodename = 'patternFill') or (nodename = 'x:patternFill') then begin patt := GetAttrValue(patternNode, 'patternType'); fgclr := scWhite; bgclr := scBlack; colorNode := patternNode.FirstChild; while Assigned(colorNode) do begin nodeName := colorNode.NodeName; if (nodeName = 'fgColor') or (nodeName = 'x:fgColor')then fgclr := ReadColor(colorNode) else if (nodeName = 'bgColor') or (nodeName = 'x:bgColor') then bgclr := ReadColor(colorNode); colorNode := colorNode.NextSibling; end; // Store in FFillList fillData := TFillListData.Create; fillData.PatternType := patt; fillData.FgColor := fgclr; fillData.BgColor := bgclr; FFillList.Add(fillData); end else if (nodeName = 'gradientFill') or (nodeName = 'x:gradientFill') then begin // We do not support gradient fills yet. As a replacement, we read // the first color of the gradient and use it for a solid fill // This is required in order to keep the fill numbering intact. stopNode := patternNode.FirstChild; while Assigned(stopNode) do begin nodeName := stopNode.NodeName; if (nodeName = 'stop') or (nodeName = 'x:stop') then begin colorNode := stopNode.FirstChild; while Assigned(colorNode) do begin nodeName := colorNode.NodeName; if (nodeName = 'color') or (nodeName = 'x:color') then begin bgclr := ReadColor(colorNode); fgclr := bgclr; break; end; colorNode := colorNode.NextSibling; end; break; end; stopNode := stopNode.NextSibling; end; // Store in FFillList: fillData := TFillListData.Create; fillData.PatternType := 'GradientFill '+IntToStr(FFillList.Count); fillData.FgColor := fgclr; fillData.BgColor := bgclr; FFillList.Add(fillData); end else if nodeName <> '#text' then begin // This pattern type is unknown to fpspreadsheet. We must store a dummy // fill data record to keep the numbering intact. fillData := TFillListData.Create; fillData.PatternType := 'non'; FFillList.Add(fillData); Workbook.AddErrorMsg('ReadFills: Unsupported pattern node ' + nodeName); end; patternNode := patternNode.NextSibling; end; fillNode := fillNode.NextSibling; end; end; { Reads the font described by the specified node and stores it in the reader's FontList. } function TsSpreadOOXMLReader.ReadFont(ANode: TDOMNode): Integer; var node: TDOMNode; fnt: TsFont; fntName: String; fntSize: Single; fntStyles: TsFontStyles; fntColor: TsColor; fntPos: TsFontPosition; nodename: String; s: String; acceptDuplicates: Boolean; isDefaultFont: Boolean; begin isDefaultFont := FFontList.Count = 0; fnt := (Workbook as TsWorkbook).GetDefaultFont; if fnt <> nil then begin fntName := fnt.FontName; fntSize := fnt.Size; fntStyles := fnt.Style; fntColor := fnt.Color; fntPos := fnt.Position; end else begin fntName := DEFAULT_FONTNAME; fntSize := DEFAULT_FONTSIZE; fntStyles := []; fntColor := scBlack; fntPos := fpNormal; end; acceptDuplicates := true; node := ANode.FirstChild; while node <> nil do begin nodename := node.NodeName; if (nodename = 'name') or (nodename = 'x:name') or (nodename = 'rFont') or (nodename = 'x:rFont') then begin s := GetAttrValue(node, 'val'); if s <> '' then fntName := s; if (nodename = 'rFont') or (nodename = 'x:rFont') then acceptDuplicates := false; end else if (nodename = 'sz') or (nodeName = 'x:sz') then begin s := GetAttrValue(node, 'val'); if s <> '' then fntSize := StrToFloat(s, FPointSeparatorSettings); end else if (nodename = 'b') or (nodename = 'x:b') then begin s := GetAttrValue(node, 'val'); if (s = '') or StrIsTrue(s) then // if GetAttrValue(node, 'val') <> 'false' then fntStyles := fntStyles + [fssBold]; end else if (nodename = 'i') or (nodename = 'x:i') then begin s := GetAttrValue(node, 'val'); if (s = '') or StrIsTrue(s) then // if GetAttrValue(node, 'val') <> 'false' then fntStyles := fntStyles + [fssItalic]; end else if (nodename = 'u') or (nodename = 'x:u') then begin s := GetAttrValue(node, 'val'); if not StrIsFalse(s) then // can have many values, not just booleans fntStyles := fntStyles+ [fssUnderline] end else if (nodename = 'strike') or (nodename = 'x:strike') then begin s := GetAttrValue(node, 'val'); if not StrIsFalse(s) then // can have several values, not just booleans fntStyles := fntStyles + [fssStrikeout]; end else if (nodename = 'vertAlign') or (nodename = 'x:vertAlign') then begin s := GetAttrValue(node, 'val'); if s = 'superscript' then fntPos := fpSuperscript else if s = 'subscript' then fntPos := fpSubscript else fntPos := fpNormal; end else if (nodename = 'color') or (nodename = 'x:color') then fntColor := ReadColor(node); node := node.NextSibling; end; // If this method is called when reading the sharedstrings.xml duplicate // fonts should not be added to the reader's fontList. // As a function result we return the index of the already existing font. if not acceptDuplicates then for Result := 0 to FFontList.Count-1 do begin fnt := TsFont(FFontList[Result]); if SameText(fnt.FontName, fntName) and (fnt.Size = fntSize) and (fnt.Style = fntStyles) and (fnt.Color = fntColor) and (fnt.Position = fntPos) then exit; end; // Create a font record and store it in the reader's fontlist. // In case of fonts in styles.xml (nodename = "name"), do no look for // duplicates because this will screw up the font index // used in the xf records fnt := TsFont.Create; fnt.FontName := fntName; fnt.Size := fntSize; fnt.Style := fntStyles; fnt.Color := fntColor; fnt.Position := fntPos; Result := FFontList.Add(fnt); if isDefaultFont then (Workbook as TsWorkbook).SetDefaultFont(fnt.FontName, fnt.Size); end; procedure TsSpreadOOXMLReader.ReadFonts(ANode: TDOMNode); var node: TDOMNode; begin if ANode = nil then exit; node := ANode.FirstChild; while node <> nil do begin ReadFont(node); node := node.NextSibling; end; end; procedure TsSpreadOOXMLReader.ReadHeaderFooter(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var node: TDOMNode; nodeName: String; s: String; sheet: TsWorksheet absolute AWorksheet; function FixLineEnding(AString: String): String; begin Result := StringReplace(AString, #10, LineEnding, [rfReplaceAll]); end; begin if ANode = nil then exit; s := GetAttrValue(ANode, 'differentOddEven'); if StrIsTrue(s) then //(s = '1') or (s = 'true') then with sheet.PageLayout do Options := Options + [poDifferentOddEven]; s := Lowercase(GetAttrValue(ANode, 'differentFirst')); if StrIsTrue(s) then //(s = '1') or (s = 'true') then with sheet.PageLayout do Options := Options + [poDifferentFirst]; node := ANode.FirstChild; while node <> nil do begin nodeName := node.NodeName; if pos('x:', nodename) = 1 then Delete(nodeName, 1, 2); case nodeName of 'firstHeader': sheet.PageLayout.Headers[0] := FixLineEnding(GetNodeValue(node)); 'oddHeader' : sheet.PageLayout.Headers[1] := FixLineEnding(GetNodeValue(node)); 'evenHeader' : sheet.PageLayout.Headers[2] := FixLineEnding(GetNodeValue(node)); 'firstFooter': sheet.PageLayout.Footers[0] := FixLineEnding(GetNodeValue(node)); 'oddFooter' : sheet.PageLayout.Footers[1] := FixLineEnding(GetNodeValue(node)); 'evenFooter' : sheet.PageLayout.Footers[2] := FixLineEnding(GetNodeValue(node)); end; node := node.NextSibling; end; end; procedure TsSpreadOOXMLReader.ReadHyperlinks(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var node: TDOMNode; nodeName: String; hyperlinkData: THyperlinkListData; s: String; function FindHyperlinkID(ID: String): THyperlinkListData; var i: Integer; begin for i:=0 to FHyperlinkList.Count-1 do if THyperlinkListData(FHyperlinkList.Items[i]).ID = ID then begin Result := THyperlinkListData(FHyperlinkList.Items[i]); exit; end; end; begin if Assigned(ANode) then begin nodename := ANode.NodeName; if (nodename = 'hyperlinks') or (nodename = 'x:hyperlinks') then begin node := ANode.FirstChild; while Assigned(node) do begin nodename := node.NodeName; if (nodename = 'hyperlink') or (nodename = 'x:hyperlink') then begin hyperlinkData := THyperlinkListData.Create; hyperlinkData.CellRef := GetAttrValue(node, 'ref'); hyperlinkData.ID := GetAttrValue(node, 'r:id'); hyperlinkData.Target := ''; hyperlinkData.TextMark := GetAttrValue(node, 'location'); hyperlinkData.Display := GetAttrValue(node, 'display'); hyperlinkData.Tooltip := GetAttrValue(node, 'tooltip'); hyperlinkData.Worksheet := AWorksheet; end; FHyperlinkList.Add(hyperlinkData); node := node.NextSibling; end; end else if (nodename = 'Relationship') or (nodename = 'x:Relationship') then begin node := ANode; while Assigned(node) do begin nodename := node.NodeName; if (nodename = 'Relationship') or (nodename = 'x:Relationship') then begin s := GetAttrValue(node, 'Type'); if s = SCHEMAS_HYPERLINK then begin s := GetAttrValue(node, 'Id'); if s <> '' then begin hyperlinkData := FindHyperlinkID(s); if hyperlinkData <> nil then begin s := GetAttrValue(node, 'Target'); if s <> '' then hyperlinkData.Target := s; s := GetAttrValue(node, 'TargetMode'); if s <> 'External' then // Only "External" accepted! begin hyperlinkData.Target := ''; hyperlinkData.TextMark := ''; end; end; end; end; end; node := node.NextSibling; end; end; end; end; procedure TsSpreadOOXMLReader.ReadMetaData(ANode: TDOMNode); var childNode: TDOMNode; nodeName: string; book: TsWorkbook; s: String; name: String; dt: TDateTime; fs: TFormatSettings; begin if ANode = nil then exit; book := TsWorkbook(FWorkbook); fs := DefaultFormatSettings; fs.DateSeparator := '-'; ANode := ANode.FirstChild; while ANode <> nil do begin nodeName := ANode.NodeName; s := GetNodeValue(ANode); case nodeName of // These fields are from "core.xml" 'dc:title': book.MetaData.Title := s; 'dc:subject': book.MetaData.Subject := s; 'dc:creator': book.MetaData.CreatedBy := s; 'cp:lastModifiedBy': book.MetaData.LastModifiedBy := s; 'dc:description': if s <> '' then begin s := StringReplace(s, '_x000d_', Lineending, [rfReplaceAll]); book.MetaData.Comments.Text := s; end else book.MetaData.Comments.Clear; 'cp:keywords': if s <> '' then book.MetaData.Keywords.CommaText := s else book.MetaData.Keywords.Clear; 'dcterms:created': if s <> '' then book.MetaData.DateCreated := ISO8601StrToDateTime(s); 'dcterms:modified': if s <> '' then book.MetaData.DateLastModified :=ISO8601StrToDateTime(s); // This field is from "custom.xml" 'property': begin name := GetAttrValue(ANode, 'name'); childNode := ANode.Firstchild; while childNode <> nil do begin nodeName := childNode.NodeName; s := GetNodeValue(childNode); if (s <> '') then book.MetaData.AddCustom(name, s); break; end; end; end; ANode := ANode.NextSibling; end; end; procedure TsSpreadOOXMLReader.ReadMergedCells(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var node: TDOMNode; nodename: String; s: String; begin if Assigned(ANode) then begin node := ANode.FirstChild; while Assigned(node) do begin nodename := node.NodeName; if (nodename = 'mergeCell') or (nodename = 'x:mergeCell') then begin s := GetAttrValue(node, 'ref'); if s <> '' then (AWorksheet as TsWorksheet).MergeCells(s); end; node := node.NextSibling; end; end; end; procedure TsSpreadOOXMLReader.ReadNumFormats(ANode: TDOMNode); var node: TDOMNode; idStr: String; fmtStr: String; nodeName: String; id: Integer; begin if Assigned(ANode) then begin node := ANode.FirstChild; while Assigned(node) do begin nodeName := node.NodeName; if (nodeName = 'numFmt') or (nodeName = 'x:numFmt') then begin fmtStr := GetAttrValue(node, 'formatCode'); idStr := GetAttrValue(node, 'numFmtId'); id := StrToInt(idStr); while id >= NumFormatList.Count do NumFormatList.Add(''); NumFormatList[id] := fmtStr; end; node := node.NextSibling; end; end; end; procedure TsSpreadOOXMLReader.ReadPageMargins(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var s: String; sheet: TsWorksheet absolute AWorksheet; begin if (ANode = nil) or (AWorksheet = nil) then // just to make sure... exit; s := GetAttrValue(ANode, 'left'); if s <> '' then sheet.PageLayout.LeftMargin := PtsToMM(HtmlLengthStrToPts(s, 'in')); s := GetAttrValue(ANode, 'right'); if s <> '' then sheet.PageLayout.RightMargin := PtsToMM(HtmlLengthStrToPts(s, 'in')); s := GetAttrValue(ANode, 'top'); if s <> '' then sheet.PageLayout.TopMargin := PtsToMM(HtmlLengthStrToPts(s, 'in')); s := GetAttrValue(ANode, 'bottom'); if s <> '' then sheet.PageLayout.BottomMargin := PtsToMM(HtmlLengthStrToPts(s, 'in')); s := GetAttrValue(ANode, 'header'); if s <> '' then sheet.PageLayout.HeaderMargin := PtsToMM(HtmlLengthStrToPts(s, 'in')); s := GetAttrValue(ANode, 'footer'); if s <> '' then sheet.PageLayout.FooterMargin := PtsToMM(HtmlLengthStrToPts(s, 'in')); end; procedure TsSpreadOOXMLReader.ReadPageSetup(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var s: String; n: Integer; sheet: TsWorksheet absolute AWorksheet; begin if ANode = nil then exit; // Paper size s := GetAttrValue(ANode, 'paperSize'); if s <> '' then begin n := StrToInt(s); if (n >= 0) and (n <= High(PAPER_SIZES)) then begin sheet.PageLayout.PageWidth := PAPER_SIZES[n, 0]; sheet.PageLayout.PageHeight := PAPER_SIZES[n, 1]; end; end; // Orientation s := GetAttrValue(ANode, 'orientation'); if s = 'portrait' then sheet.PageLayout.Orientation := spoPortrait else if s = 'landscape' then sheet.PageLayout.Orientation := spoLandscape; // Scaling factor s := GetAttrValue(ANode, 'scale'); if s <> '' then sheet.PageLayout.ScalingFactor := StrToInt(s); // poFitPages is automatically excluded // Fit print job to pages s := GetAttrValue(ANode, 'fitToHeight'); if s <> '' then sheet.PageLayout.FitHeightToPages := StrToInt(s); // poFitPages is automatically included. s := GetAttrValue(ANode, 'fitToWidth'); if s <> '' then sheet.PageLayout.FitWidthToPages := StrToInt(s); // poFitPages is automatially included. // First page number s := GetAttrValue(ANode, 'firstPageNumber'); if s <> '' then sheet.PageLayout.StartPageNumber := StrToInt(s); s := Lowercase(GetAttrValue(ANode, 'useFirstPageNumber')); with sheet.PageLayout do if (s = '1') or (s = 'true') then Options := Options + [poUseStartPageNumber] else Options := Options - [poUseStartPageNumber]; // Print order s := GetAttrValue(ANode, 'pageOrder'); if s = 'overThenDown' then with sheet.PageLayout do Options := Options + [poPrintPagesByRows]; // Monochrome s := LowerCase(GetAttrValue(ANode, 'blackAndWhite')); if StrIsTrue(s) then //(s = '1') or (s = 'true') then with sheet.PageLayout do Options := Options + [poMonochrome]; // Quality s := Lowercase(GetAttrValue(ANode, 'draft')); if StrIsTrue(s) then //(s = '1') or (s = 'true') then with sheet.PageLayout do Options := Options + [poDraftQuality]; end; procedure TsSpreadOOXMLReader.ReadPalette(ANode: TDOMNode); var node, colornode: TDOMNode; nodename: String; s: string; cidx: Integer; // color index rgb: TsColor; n: Integer; begin // OOXML sometimes specifies color by index even if a palette ("indexedColors") // is not loaeded. Therefore, we use the BIFF8 palette as default because // the default indexedColors are identical to it. FPalette.Clear; FPalette.AddBuiltinColors; // This adds the BIFF2 colors 0..7 FPalette.AddExcelColors; // This adds the BIFF8 colors 8..63 n := FPalette.Count; if ANode = nil then exit; cidx := 0; node := ANode.FirstChild; while Assigned(node) do begin nodename := node.NodeName; if (nodename = 'indexedColors') or (nodename = 'x:indexedColors') then begin colornode := node.FirstChild; while Assigned(colornode) do begin nodename := colornode.NodeName; if (nodename = 'rgbColor') or (nodename = 'x:rgbColor') then begin s := GetAttrValue(colornode, 'rgb'); if s <> '' then begin rgb := HTMLColorStrToColor('#' + s); if cidx < n then begin FPalette[cidx] := rgb; inc(cidx); end else FPalette.AddColor(rgb); end; end; colornode := colorNode.NextSibling; end; end; node := node.NextSibling; end; end; procedure TsSpreadOOXMLReader.ReadPrintOptions(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var s: String; sheet: TsWorksheet absolute AWorksheet; begin if ANode = nil then exit; s := Lowercase(GetAttrValue(ANode, 'headings')); if StrIsTrue(s) then //(s = '1') or (s = 'true') then with sheet.PageLayout do Options := Options + [poPrintHeaders]; s := Lowercase(GetAttrValue(ANode, 'gridLines')); if StrIsTrue(s) then //(s = '1') or (s = 'true') then with sheet.PageLayout do Options := Options + [poPrintGridLines]; end; procedure TsSpreadOOXMLReader.ReadRow(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; var ARowIndex: Cardinal); var s: String; r: Cardinal; lRow: TRow; fmt: PsCellFormat; idx: Integer; begin if ANode = nil then exit; { Row height type } s := Lowercase(GetAttrValue(ANode, 'customHeight')); if StrIsTrue(s) then //(s = '1') or (s = 'true') then lRow.RowHeightType := rhtCustom else lRow.RowHeightType := rhtAuto; { Row height value, in points - if there is no "ht" attribute we assume that it is the default row height } s := GetAttrValue(ANode, 'ht'); if s = '' then begin lRow.Height := (AWorksheet as TsWorksheet).ReadDefaultRowHeight(FWorkbook.Units); lRow.RowHeightType := rhtDefault; end else lRow.Height := (FWorkbook as TsWorkbook).ConvertUnits( StrToFloat(s, FPointSeparatorSettings), suPoints, FWorkbook.Units ); { Row index } s := GetAttrValue(ANode, 'r'); if s = '' then r := ARowIndex else r := StrToInt(s) - 1; { Row format } lRow.FormatIndex := 0; // Default format s := Lowercase(GetAttrValue(ANode, 'customFormat')); if StrIsTrue(s) then //(s = '1') or (s = 'true') then begin s := GetAttrValue(ANode, 's'); if s <> '' then begin idx := FCellFormatList.FindIndexOfID(StrToInt(s)); fmt := FCellFormatList.Items[idx]; lRow.FormatIndex := (FWorkbook as TsWorkbook).AddCellFormat(fmt^); end; end; { Row visibility } lRow.Options := []; s := GetAttrvalue(ANode, 'hidden'); if StrIsTrue(s) then Include(lRow.Options, croHidden); { Write out } if (lRow.RowHeightType <> rhtDefault) or (lRow.FormatIndex <> 0) or (lRow.Options <> []) then (AWorksheet as TsWorksheet).WriteRowInfo(r, lRow); end; procedure TsSpreadOOXMLReader.ReadSharedStrings(ANode: TDOMNode); var valuenode: TDOMNode; childnode: TDOMNode; nodename: String; totaltxt, sval: String; fntIndex: Integer; rtParams: TsRichTextParams = nil; ms: TMemoryStream; fnt: TsFont; begin while Assigned(ANode) do begin nodename := ANode.NodeName; if (nodeName = 'si') or (nodeName = 'x:si') then begin totaltxt := ''; SetLength(rtParams, 0); valuenode := ANode.FirstChild; while valuenode <> nil do begin nodename := valuenode.NodeName; if (nodename = 't') or (nodename = 'x:t') then // this is unformatted text totaltxt := GetNodeValue(valuenode) else if (nodename = 'r') or (nodename = 'x:r') then begin // all rich-text formatted texts are defined by r nodes fntIndex := -1; childnode := valuenode.FirstChild; while childnode <> nil do begin nodename := childnode.NodeName; if (nodename = 't') or (nodename = 'x:t') then begin sval := GetNodeValue(childNode); totaltxt := totaltxt + sval; end else if (nodename = 'rPr') or (nodename = 'x:rPr') then begin fntIndex := ReadFont(childnode); // Here we store the font in the internal font list of the reader. // But this fontindex may be different from the one needed for the // workbook's font list. We fix this here. fnt := TsFont(FFontList[fntIndex]); fntIndex := (Workbook as TsWorkbook).FindFont( fnt.FontName, fnt.Size, fnt.style, fnt.Color, fnt.Position ); if fntIndex = -1 then fntIndex := (Workbook as TsWorkbook).AddFont( fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position ); SetLength(rtParams, Length(rtParams)+1); rtParams[High(rtParams)].FirstIndex := UTF8Length(totaltxt) + 1; rtParams[High(rtParams)].FontIndex := fntIndex; rtParams[High(rtParams)].HyperlinkIndex := -1; end; childnode := childnode.NextSibling; end; end; valuenode := valuenode.NextSibling; end; if Length(rtParams) = 0 then FSharedStrings.Add(totaltxt) else begin ms := TMemoryStream.Create; ms.WriteWord(Length(rtParams)); ms.WriteBuffer(rtParams[0], SizeOf(TsRichTextParam)*Length(rtParams)); FSharedStrings.AddObject(totaltxt, ms); end; end; ANode := ANode.NextSibling; end; end; procedure TsSpreadOOXMLReader.ReadSheetFormatPr(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var w, h: Double; s: String; begin if ANode = nil then exit; s := GetAttrValue(ANode, 'defaultColWidth'); // is in characters if (s <> '') and TryStrToFloat(s, w, FPointSeparatorSettings) then (AWorksheet as TsWorksheet).WriteDefaultColWidth(w, suChars); s := GetAttrValue(ANode, 'defaultRowHeight'); // is in points if (s <> '') and TryStrToFloat(s, h, FPointSeparatorSettings) then (AWorksheet as TsWorksheet).WriteDefaultRowHeight(h, suPoints); end; procedure TsSpreadOOXMLReader.ReadSheetList(ANode: TDOMNode); var node: TDOMNode; nodename: String; sheetData: TSheetData; begin if ANode = nil then exit; node := ANode.FirstChild; while node <> nil do begin nodename := node.NodeName; if (nodename = 'sheet') or (nodename = 'x:sheet') then begin sheetData := TSheetData.Create; sheetData.Name := GetAttrValue(node, 'name'); sheetData.ID := GetAttrvalue(node, 'sheetID'); sheetData.Hidden := GetAttrValue(node, 'state') = 'hidden'; FSheetList.Add(sheetData); // Create worksheet - needed because of 3d references (FWorkbook as TsWorkbook).AddWorksheet(sheetData.Name, true); end; node := node.NextSibling; end; end; procedure TsSpreadOOXMLReader.ReadSheetPR(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var node: TDOMNode; nodename: String; begin if ANode = nil then exit; node := ANode.FirstChild; while node <> nil do begin nodeName := node.NodeName; if nodeName = 'tabColor' then begin TsWorksheet(AWorksheet).TabColor := ReadColor(node); end; node := node.NextSibling; end; end; procedure TsSpreadOOXMLReader.ReadSheetProtection(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var s: String; shc: TsCryptoInfo; shp: TsWorksheetProtections; begin if ANode = nil then exit; InitCryptoInfo(shc); s := GetAttrValue(ANode, 'password'); if s <> '' then begin shc.PasswordHash := s; shc.Algorithm := caExcel; end else begin s := GetAttrValue(ANode, 'hashValue'); if s <> '' then begin shc.PasswordHash := s; s := GetAttrValue(ANode, 'algorithmName'); shc.Algorithm := StrToAlgorithm(s); if shc.Algorithm = caUnknown then Workbook.AddErrorMsg('Found unknown encryption algorithm "%s" for worksheet protection', [s]); s := GetAttrValue(ANode, 'saltValue'); shc.SaltValue := s; s := GetAttrValue(ANode, 'spinCount'); shc.SpinCount := StrToIntDef(s, 0); end; end; (AWorksheet as TsWorksheet).CryptoInfo := shc; shp := DEFAULT_SHEET_PROTECTION; // Attribute not found -> property = false s := GetAttrValue(ANode, 'sheet'); if StrIsTrue(s) then //(s = '1') or (s = 'true') then Include(shp, spCells) else if (s = '') or StrIsFalse(s) then //(s = '0') or (s = '') or (s = 'false') then Exclude(shp, spCells); s := GetAttrValue(ANode, 'selectLockedCells'); if StrIsTrue(s) then //(s = '1') or (s = 'true') then Include(shp, spSelectLockedCells) else if (s = '') or StrIsFalse(s) then //(s = '0') or (s = '') or (s = 'false') then Exclude(shp, spSelectLockedCells); s := GetAttrValue(ANode, 'selectUnlockedCells'); if StrIsTrue(s) then //(s = '1') or (s = 'true') then Include(shp, spSelectUnlockedCells) else if (s = '') or StrIsFalse(s) then //if (s = '') or (s = '0') or (s = 'false') then Exclude(shp, spSelectUnlockedCells); s := GetAttrValue(ANode, 'objects'); if StrIsTrue(s) then // (s = '1') or (s = 'true') then Include(shp, spObjects) else if (s = '') or StrIsFalse(s) then //(s = '') or (s = '0') or (s = 'false') then Exclude(shp, spObjects); // these options are currently not supported by fpspreadsheet { s := GetAttrValue(ANode, 'scenarios'); if StrIsTrue(s) then Include(shp, spScenarios) else if (s = '') or StrIsFalse(s) then Exclude(shp, spScenarios); } // Attribute not found -> property = true { s := GetAttrValue(ANode, 'autoFilter'); if StrIsFalse(s) then Exclude(shp, spAutoFilter) else if (s = '') or StrIsTrue(s) then Include(shp, spAutoFilter); } s := GetAttrValue(ANode, 'deleteColumns'); if StrIsFalse(s) then // (s = '0') or (s = 'true') then Exclude(shp, spDeleteColumns) else if (s = '') or StrIsTrue(s) then // (s = '1') or (s = 'false') then Include(shp, spDeleteColumns); s := GetAttrValue(ANode, 'deleteRows'); if StrIsFalse(s) then //(s = '0') or (s = 'false') then Exclude(shp, spDeleteRows) else if (s = '') or StrIsTrue(s) then //(s = '1') or (s = 'true') then Include(shp, spDeleteRows); s := GetAttrValue(ANode, 'formatCells'); if StrIsFalse(s) then // (s = '0') or (s = 'false') then Exclude(shp, spFormatCells) else if (s = '') or StrIsTrue(s) then //(s = '1') or (s = 'true') then Include(shp, spFormatCells); s := GetAttrValue(ANode, 'formatColumns'); if StrIsFalse(s) then //(s = '0') or (s = 'false') then Exclude(shp, spFormatColumns) else if (s = '') or StrIsTrue(s) then // (s = '1') or (s = 'true') then Include(shp, spFormatColumns); s := GetAttrValue(ANode, 'formatRows'); if StrIsFalse(s) then // (s = '0') or (s = 'false') then Exclude(shp, spFormatRows) else if (s = '') or StrIsTrue(s) then // (s = '1') or (s = 'true') then Include(shp, spFormatRows); s := GetAttrValue(ANode, 'insertColumns'); if StrIsFalse(s) then // (s = '0') or (s = 'false') then Exclude(shp, spInsertColumns) else if (s = '') or StrIsTrue(s) then // (s = '1') or (s = 'true') then Include(shp, spInsertColumns); s := GetAttrValue(ANode, 'insertHyperlinks'); if StrIsFalse(s) then //(s = '0') or (s = 'false') then Exclude(shp, spInsertHyperlinks) else if (s = '') or StrIsTrue(s) then //(s = '1') or (s = 'true') then Include(shp, spInsertHyperlinks); s := GetAttrValue(ANode, 'insertRows'); if StrIsFalse(s) then // (s = '0') then Exclude(shp, spInsertRows) else if (s = '') or StrIsTrue(s) then // (s = '1') then Include(shp, spInsertRows); s := GetAttrValue(ANode, 'sort'); if StrIsFalse(s) then // (s = '0') or (s = 'false') then Exclude(shp, spSort) else if (s = '') or StrIsTrue(s) then // (s = '1') or (s = 'true') then Include(shp, spSort); // Currently no pivottable support in fpspreadsheet { s := GetAttrValue(ANode, 'pivotTables'); if StrIsFalse(s) then Exclude(shp, spPivotTables) else if (s = '') or StrIsTrue(s) then Include(shp, spPivotTables); } with AWorksheet as TsWorksheet do begin Protection := shp; Protect(true); end; end; procedure TsSpreadOOXMLReader.ReadSheetViews(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var sheetViewNode: TDOMNode; childNode: TDOMNode; nodeName: String; s: String; actRow, actCol: Cardinal; sheet: TsWorksheet absolute AWorksheet; begin if ANode = nil then exit; sheetViewNode := ANode.FirstChild; while Assigned(sheetViewNode) do begin nodeName := sheetViewNode.NodeName; if (nodeName = 'sheetView') or (nodeName = 'x:sheetView') then begin s := GetAttrValue(sheetViewNode, 'showGridLines'); if StrIsFalse(s) then //(s = '0') or (s = 'false') then sheet.Options := AWorksheet.Options - [soShowGridLines]; s := GetAttrValue(sheetViewNode, 'showRowColHeaders'); if StrIsFalse(s) then //(s = '0') or (s = 'false') then sheet.Options := AWorksheet.Options - [soShowHeaders]; s := GetAttrValue(sheetViewNode, 'tabSelected'); if StrIsTrue(s) then //(s = '1') or (s = 'true') then (FWorkbook as TsWorkbook).ActiveWorksheet := sheet; s := Lowercase(GetAttrValue(sheetViewNode, 'windowProtection')); if StrIsTrue(s) then //(s = '1') or (s = 'true') then sheet.Options := sheet.Options + [soPanesProtection]; s := GetAttrValue(sheetViewNode, 'zoomScale'); if s <> '' then sheet.ZoomFactor := StrToFloat(s, FPointSeparatorSettings) * 0.01; s := Lowercase(GetAttrValue(sheetViewNode, 'rightToLeft')); if (s = '') or StrIsFalse(s) then //(s = '0') or (s = 'false') then sheet.BiDiMode := bdLTR else if StrIsTrue(s) then //(s = '1') or (s = 'true') then sheet.BiDiMode := bdRTL; childNode := sheetViewNode.FirstChild; while Assigned(childNode) do begin nodeName := childNode.NodeName; if (nodeName = 'pane') or (nodeName = 'x:pane') then begin s := GetAttrValue(childNode, 'state'); if s = 'frozen' then begin sheet.Options := sheet.Options + [soHasFrozenPanes]; s := GetAttrValue(childNode, 'xSplit'); if s <> '' then sheet.LeftPaneWidth := round(StrToFloat(s, FPointSeparatorSettings)); s := GetAttrValue(childNode, 'ySplit'); if s <> '' then sheet.TopPaneHeight := round(StrToFloat(s, FPointSeparatorSettings)); end; end else if (nodeName = 'selection') or (nodeName = 'x:selection') then begin s := GetAttrValue(childnode, 'activeCell'); if s <> '' then begin ParseCellString(s, actRow, actCol); sheet.SelectCell(actRow, actCol); end; end; childNode := childNode.NextSibling; end; end; sheetViewNode := sheetViewNode.NextSibling; end; end; procedure TsSpreadOOXMLReader.ReadThemeColors(ANode: TDOMNode); var clrNode: TDOMNode; nodeName: String; procedure AddColor(AColorStr: String); begin if AColorStr <> '' then begin SetLength(FThemeColors, Length(FThemeColors)+1); FThemeColors[Length(FThemeColors)-1] := HTMLColorStrToColor('#' + AColorStr); end; end; begin if not Assigned(ANode) then exit; SetLength(FThemeColors, 0); clrNode := ANode.FirstChild; while Assigned(clrNode) do begin nodeName := clrNode.NodeName; if nodeName = 'a:dk1' then AddColor(GetAttrValue(clrNode.FirstChild, 'lastClr')) else if nodeName = 'a:lt1' then AddColor(GetAttrValue(clrNode.FirstChild, 'lastClr')) else if nodeName = 'a:dk2' then AddColor(GetAttrValue(clrNode.FirstChild, 'val')) else if nodeName = 'a:lt2' then AddColor(GetAttrValue(clrNode.FirstChild, 'val')) else if nodeName = 'a:accent1' then AddColor(GetAttrValue(clrNode.FirstChild, 'val')) else if nodeName = 'a:accent2' then AddColor(GetAttrValue(clrNode.FirstChild, 'val')) else if nodeName = 'a:accent3' then AddColor(GetAttrValue(clrNode.FirstChild, 'val')) else if nodeName = 'a:accent4' then AddColor(GetAttrValue(clrNode.FirstChild, 'val')) else if nodeName = 'a:accent5' then AddColor(GetAttrValue(clrNode.FirstChild, 'val')) else if nodeName = 'a:accent6' then AddColor(GetAttrValue(clrNode.FirstChild, 'val')) else if nodeName = 'a:hlink' then AddColor(GetAttrValue(clrNode.FirstChild, 'val')) else if nodeName = 'a:folHlink' then AddColor(GetAttrValue(clrNode.FirstChild, 'aval')); clrNode := clrNode.NextSibling; end; end; procedure TsSpreadOOXMLReader.ReadThemeElements(ANode: TDOMNode); var childNode: TDOMNode; nodeName: String; begin if not Assigned(ANode) then exit; childNode := ANode.FirstChild; while Assigned(childNode) do begin nodeName := childNode.NodeName; if nodeName = 'a:clrScheme' then ReadThemeColors(childNode); childNode := childNode.NextSibling; end; end; procedure TsSpreadOOXMLReader.ReadWorkbookProtection(ANode: TDOMNode); var s : string; wbc: TsCryptoInfo; wbp: TsWorkbookProtections; begin if ANode = nil then Exit; s := ''; wbp := []; InitCryptoInfo(wbc); s := GetAttrValue(ANode, 'workbookPassword'); if s <> '' then wbc.PasswordHash := s else begin s := GetAttrValue(ANode, 'workbookHashVal'); if s <> '' then begin wbc.PasswordHash := s; s := GetAttrValue(ANode, 'workbookAlgorithmName'); wbc.Algorithm := StrToAlgorithm(s); if wbc.Algorithm = caUnknown then Workbook.AddErrorMsg('Found unknown encryption algorithm "%s" for workbook protection', [s]); wbc.SaltValue := GetAttrValue(ANode, 'workbookSaltValue'); wbc.SpinCount := StrToIntDef(GetAttrValue(ANode, 'workbookSpinCount'), 0); end; end; (Workbook as TsWorkbook).CryptoInfo := wbc; { InitCryptoInfo(wbc); s := GetAttrValue(ANode, 'revisionsPassword'); if s <> '' then wbc.Password := s else begin s := GetAttrValue(ANode, 'revisionsHashValue'); if s <> '' then begin wbc.HashValue := s; wbc.AlgorithmName := GetAttrValue(ANode, 'revisionsAlgorithm'); wbc.SaltValue := GetAttrValue(ANode, 'revisionsSaltValue'); wbc.SpinCount := StrToIntDef(GetAttrValue(ANode, 'revisionsSpinCount'), 0); end; end; Workbook.RevisionsCrypto := wbc; } s := GetAttrValue(ANode, 'lockStructure'); if StrIsTrue(s) then // (s = '1') or (s = 'true')then Include(wbp, bpLockStructure); s := GetAttrValue(ANode, 'lockWindows'); if StrIsTrue(s) then //(s = '1') or (s = 'true') then Include(wbp, bpLockWindows); s := GetAttrValue(ANode, 'lockRevision'); if StrIsTrue(s) then //(s = '1') or (s = 'true') then Include(wbp, bpLockRevision); Workbook.Protection := wbp; end; procedure TsSpreadOOXMLReader.ReadWorksheet(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var rownode: TDOMNode; cellnode: TDOMNode; nodename: String; r, c: Cardinal; begin rownode := ANode.FirstChild; r := 0; while Assigned(rownode) do begin nodeName := rownode.NodeName; if (nodeName = 'row') or (nodeName = 'x:row') then begin ReadRow(rownode, AWorksheet, r); cellnode := rownode.FirstChild; c := 0; while Assigned(cellnode) do begin nodename := cellnode.NodeName; if (nodeName = 'c') or (nodeName = 'x:c') then ReadCell(cellnode, AWorksheet, r, c); cellnode := cellnode.NextSibling; end; inc(r); end; rownode := rownode.NextSibling; end; FixCols(AWorksheet); FixRows(AWorksheet); end; procedure TsSpreadOOXMLReader.ReadFromStream(AStream: TStream; APassword: String = ''; AParams: TsStreamParams = []); var Doc : TXMLDocument; metadataNode: TDOMNode; RelsNode: TDOMNode; i, j: Integer; fn: String; fn_comments: String; XMLStream: TStream; actSheetIndex: Integer; function CreateXMLStream: TStream; begin if boFileStream in FWorkbook.Options then Result := TFileStream.Create(GetTempFileName, fmCreate) else if boBufStream in FWorkbook.Options then Result := TBufStream.Create(GetTempFileName, fmCreate) else Result := TMemoryStream.Create; end; function Doc_FindNode(ANodeName: String): TDOMNode; begin Result := Doc.DocumentElement.FindNode(ANodeName); if Result = nil then Result := Doc.DocumentElement.FindNode('x:' + ANodeName); end; begin Unused(APassword, AParams); Doc := nil; try // Retrieve theme colors XMLStream := CreateXMLStream; try if UnzipToStream(AStream, OOXML_PATH_XL_THEME, XMLStream) then begin ReadXMLStream(Doc, XMLStream); ReadThemeElements(Doc.DocumentElement.FindNode('a:themeElements')); FreeAndNil(Doc); end; finally XMLStream.Free; end; // process the workbook.xml file (1st run) XMLStream := CreateXMLStream; try if not UnzipToStream(AStream, OOXML_PATH_XL_WORKBOOK, XMLStream) then raise EFPSpreadsheetReader.CreateFmt(rsDefectiveInternalFileStructure, ['xlsx']); ReadXMLStream(Doc, XMLStream); ReadFileVersion(Doc_FindNode('fileVersion')); ReadDateMode(Doc_FindNode('workbookPr')); ReadWorkbookProtection(Doc_FindNode('workbookProtection')); ReadSheetList(Doc_FindNode('sheets')); //ReadDefinedNames(Doc.DocumentElement.FindNode('definedNames')); -- don't read here because sheets do not yet exist ReadActiveSheet(Doc_FindNode('bookViews'), actSheetIndex); FreeAndNil(Doc); finally XMLStream.Free; end; // process the styles.xml file XMLStream := CreateXMLStream; try // Should always exist, just to make sure... if UnzipToStream(AStream, OOXML_PATH_XL_STYLES, XMLStream) then begin ReadXMLStream(Doc, XMLStream); ReadPalette(Doc_FindNode('colors')); ReadFonts(Doc_FindNode('fonts')); ReadFills(Doc_FindNode('fills')); ReadBorders(Doc_FindNode('borders')); ReadNumFormats(Doc_FindNode('numFmts')); ReadCellXfs(Doc_FindNode('cellXfs')); ReadDifferentialFormats(DOC_FindNode('dxfs')); FreeAndNil(Doc); end; finally XMLStream.Free; end; // process the sharedstrings.xml file // To do: Use buffered stream instead since shared strings may be large XMLStream := CreateXMLStream; try if UnzipToStream(AStream, OOXML_PATH_XL_STRINGS, XMLStream) then begin ReadXMLStream(Doc, XMLStream); ReadSharedStrings(Doc_FindNode('si')); FreeAndNil(Doc); end; finally XMLStream.Free; end; // read worksheets for i:=0 to FSheetList.Count-1 do begin { // Create worksheet FWorksheet := (FWorkbook as TsWorkbook).AddWorksheet(TSheetData(FSheetList[i]).Name, true); } // Worksheets are already created... FWorksheet := (FWorkbook as TsWorkbook).GetWorksheetByName(TSheetData(FSheetList[i]).Name); if TSheetData(FSheetList[i]).Hidden then FWorksheet.Options := FWorksheet.Options + [soHidden]; // unzip sheet file XMLStream := CreateXMLStream; try fn := OOXML_PATH_XL_WORKSHEETS + Format('sheet%d.xml', [i+1]); if not UnzipToStream(AStream, fn, XMLStream) then Continue; ReadXMLStream(Doc, XMLStream); finally XMLStream.Free; end; // clear sharedformulabase list for j:=FSharedFormulaBaseList.Count-1 downto 0 do TObject(FSharedFormulaBaseList[j]).Free; FSharedFormulaBaseList.Clear; // Sheet data, formats, etc. ReadSheetPr(Doc_FindNode('sheetPr'), FWorksheet); ReadDimension(Doc_FindNode('dimension'), FWorksheet); ReadSheetViews(Doc_FindNode('sheetViews'), FWorksheet); ReadSheetFormatPr(Doc_FindNode('sheetFormatPr'), FWorksheet); ReadCols(Doc_FindNode('cols'), FWorksheet); ReadWorksheet(Doc_FindNode('sheetData'), FWorksheet); ReadConditionalFormatting(Doc_FindNode('conditionalFormatting'), FWorksheet); ReadSheetProtection(Doc_FindNode('sheetProtection'), FWorksheet); ReadMergedCells(Doc_FindNode('mergeCells'), FWorksheet); ReadHyperlinks(Doc_FindNode('hyperlinks'), FWorksheet); ReadPrintOptions(Doc_FindNode('printOptions'), FWorksheet); ReadPageMargins(Doc_FindNode('pageMargins'), FWorksheet); ReadPageSetup(Doc_FindNode('pageSetup'), FWorksheet); ReadColRowBreaks(Doc_FindNode('rowBreaks'), FWorksheet); ReadColRowBreaks(Doc_FindNode('colBreaks'), FWorksheet); ReadHeaderFooter(Doc_FindNode('headerFooter'), FWorksheet); FreeAndNil(Doc); { Comments: The comments are stored in separate "comments.xml" files (n = 1, 2, ...) The relationship which comment belongs to which sheet file must be retrieved from the "sheet.xml.rels" file (n = 1, 2, ...). The rels file contains also the second part of the hyperlink data. } fn := OOXML_PATH_XL_WORKSHEETS_RELS + Format('sheet%d.xml.rels', [i+1]); XMLStream := CreateXMLStream; try if UnzipToStream(AStream, fn, XMLStream) then begin // Find exact name of comments.xml file ReadXMLStream(Doc, XMLStream); RelsNode := Doc_FindNode('Relationship'); fn_comments := FindCommentsFileName(RelsNode); // Get hyperlink data ReadHyperlinks(RelsNode, FWorksheet); FreeAndNil(Doc); end else if (FSheetList.Count = 1) then // If the workbook has only one sheet then the sheet.xml.rels file // is missing fn_comments := 'comments1.xml' else // This sheet does not have any cell comments at all fn_comments := ''; //continue; finally XMLStream.Free; end; // Extract texts from the comments file found and apply to worksheet. if fn_comments <> '' then begin fn := OOXML_PATH_XL + fn_comments; XMLStream := CreateXMLStream; try if UnzipToStream(AStream, fn, XMLStream) then begin ReadXMLStream(Doc, XMLStream); ReadComments(Doc_FindNode('commentList'), FWorksheet); FreeAndNil(Doc); end; finally XMLStream.Free; end; end; // Add hyperlinks to cells ApplyHyperlinks(FWorksheet); // Active worksheet if i = actSheetIndex then (FWorkbook as TsWorkbook).SelectWorksheet(FWorksheet as TsWorksheet); end; // for // 2nd run for the workbook.xml file // Read defined names XMLStream := CreateXMLStream; try if not UnzipToStream(AStream, OOXML_PATH_XL_WORKBOOK, XMLStream) then raise EFPSpreadsheetReader.CreateFmt(rsDefectiveInternalFileStructure, ['xlsx']); ReadXMLStream(Doc, XMLStream); ReadDefinedNames(Doc_FindNode('definedNames')); FreeAndNil(Doc); finally XMLStream.Free; end; // MetaData XMLStream := CreateXMLStream; try if UnzipToStream(AStream, OOXML_PATH_DOCPROPS_CORE, XMLStream) then begin ReadXMLStream(Doc, XMLStream); ReadMetaData(Doc.DocumentElement); FreeandNil(Doc); end; finally XMLStream.Free; end; // custom meta data XMLStream := CreateXMLStream; try if UnzipToStream(AStream, OOXML_PATH_DOCPROPS_CUSTOM, XMLStream) then begin ReadXMLStream(Doc, XMLStream); ReadMetaData(Doc.DocumentElement); FreeAndNil(Doc); end; finally XMLStream.Free; end; finally FreeAndNil(Doc); end; end; {------------------------------------------------------------------------------} { TsSpreadOOXMLWriter } {------------------------------------------------------------------------------} {@@ ---------------------------------------------------------------------------- Constructor of the OOXML writer Defines the date mode and the limitations of the file format. Initializes the format settings to be used when writing to xml. -------------------------------------------------------------------------------} constructor TsSpreadOOXMLWriter.Create(AWorkbook: TsBasicWorkbook); begin inherited Create(AWorkbook); // Initial base date in case it won't be set otherwise. // Use 1900 to get a bit more range between 1900..1904. FDateMode := XlsxSettings.DateMode; // Special version of FormatSettings using a point decimal separator for sure. FPointSeparatorSettings := DefaultFormatSettings; FPointSeparatorSettings.DecimalSeparator := '.'; InitOOXMLLimitations(FLimitations); end; {@@ ---------------------------------------------------------------------------- Looks for the combination of border attributes of the given format record in the FBorderList and returns its index. -------------------------------------------------------------------------------} function TsSpreadOOXMLWriter.FindBorderInList(AFormat: PsCellFormat): Integer; var i: Integer; fmt: PsCellFormat; begin // No cell, or border-less --> index 0 if (AFormat = nil) or not (uffBorder in AFormat^.UsedFormattingFields) then begin Result := 0; exit; end; for i:=0 to High(FBorderList) do begin fmt := FBorderList[i]; if SameCellBorders(fmt, AFormat) then begin Result := i; exit; end; end; // Not found --> return -1 Result := -1; end; {@@ ---------------------------------------------------------------------------- Looks for the combination of fill attributes of the given format record in the FFillList and returns its index. -------------------------------------------------------------------------------} function TsSpreadOOXMLWriter.FindFillInList(AFormat: PsCellFormat): Integer; var i: Integer; fmt: PsCellFormat; begin if (AFormat = nil) or not (uffBackground in AFormat^.UsedFormattingFields) then begin Result := 0; exit; end; // Index 0 is "no fill" which already has been handled. for i:=1 to High(FFillList) do begin fmt := FFillList[i]; if (fmt <> nil) and (uffBackground in fmt^.UsedFormattingFields) then begin if (AFormat^.Background.Style = fmt^.Background.Style) and (AFormat^.Background.BgColor = fmt^.Background.BgColor) and (AFormat^.Background.FgColor = fmt^.Background.FgColor) then begin Result := i; exit; end; end; end; // Not found --> return -1 Result := -1; end; { Calculates the rIds for comments, hyperlinks, image, and header/footer images of the specified worksheet } procedure TsSpreadOOXMLWriter.Get_rId(AWorksheet: TsBasicWorksheet; out AComment_rId, AFirstHyperlink_rId, ADrawing_rId, ADrawingHF_rId: Integer); var next_rId: Integer; sheet: TsWorksheet; begin sheet := AWorksheet as TsWorksheet; AComment_rId := -1; AFirstHyperlink_rId := -1; ADrawing_rId := -1; ADrawingHF_rId := -1; next_rId := 1; // Comments first if sheet.Comments.Count > 0 then begin AComment_rId := next_rId; inc(next_rId, 2); // there are two .rels entries in case of comments end; // Embedded images next if sheet.GetImageCount > 0 then begin ADrawing_rId := next_rId; inc(next_rId); end; // HeaderFooter images next if sheet.PageLayout.HasHeaderFooterImages then begin ADrawingHF_rId := next_rId; inc(next_rId); end; // Hyperlinks at the end because it is not clear how many rIds will be // used without analyzing the hyperlink. if sheet.Hyperlinks.Count > 0 then AFirstHyperlink_rId := next_rId; end; function TsSpreadOOXMLWriter.GetActiveTab: String; var book: TsWorkbook; begin book := FWorkbook as TsWorkbook; Result := IfThen(book.ActiveWorksheet = nil, '', ' activeTab="' + IntToStr(book.GetWorksheetIndex(book.ActiveWorksheet)) + '"'); end; { Determines the formatting index which a given cell has in list of "FormattingStyles" which correspond to the section cellXfs of the styles.xml file. } function TsSpreadOOXMLWriter.GetStyleIndex(ACell: PCell): Cardinal; begin Result := ACell^.FormatIndex; end; { Creates a list of all border styles found in the workbook. The list contains indexes into the array FFormattingStyles for each unique combination of border attributes. To be used for the styles.xml. } procedure TsSpreadOOXMLWriter.ListAllBorders; var //styleCell: PCell; i, n : Integer; fmt: PsCellFormat; book: TsWorkbook; begin book := FWorkbook as TsWorkbook; // first list entry is a no-border cell n := 1; SetLength(FBorderList, n); FBorderList[0] := nil; for i := 0 to book.GetNumCellFormats - 1 do begin fmt := book.GetPointerToCellFormat(i); if FindBorderInList(fmt) = -1 then begin SetLength(FBorderList, n+1); FBorderList[n] := fmt; inc(n); end; end; end; { FDifferentialFormatIndexList stores the indexes of the cells formats used in conditional formatting. } procedure TsSpreadOOXMLWriter.ListAllDifferentialFormats; var book: TsWorkbook; n: Integer; idx: Integer; j, k, d: Integer; CF: TsConditionalFormat; rule: TsCFCellRule; begin n := 0; SetLength(FDifferentialFormatIndexList, n); book := TsWorkbook(FWorkbook); for j := 0 to book.GetNumConditionalFormats-1 do begin CF := book.GetConditionalFormat(j); for k := 0 to CF.RulesCount-1 do if CF.Rules[k] is TsCFCellRule then begin rule := TsCFCellRule(CF.Rules[k]); idx := -1; for d := 0 to High(FDifferentialFormatIndexList) do if FDifferentialFormatIndexList[d] = rule.FormatIndex then begin idx := d; break; end; if idx = -1 then begin SetLength(FDifferentialFormatIndexList, n+1); FDifferentialFormatIndexList[n] := rule.FormatIndex; inc(n); end; end; end; end; { Creates a list of all fill styles found in the workbook. The list contains indexes into the array FFormattingStyles for each unique combination of fill attributes. Currently considers only backgroundcolor, fill style is always "solid". To be used for styles.xml. } procedure TsSpreadOOXMLWriter.ListAllFills; var i, n: Integer; fmt: PsCellFormat; book: TsWorkbook; begin book := FWorkbook as TsWorkbook; // Add built-in fills first. n := 2; SetLength(FFillList, n); FFillList[0] := nil; // built-in "no fill" FFillList[1] := nil; // built-in "gray125" for i := 0 to book.GetNumCellFormats - 1 do begin fmt := book.GetPointerToCellFormat(i); if FindFillInList(fmt) = -1 then begin SetLength(FFillList, n+1); FFillList[n] := fmt; inc(n); end; end; end; procedure TsSpreadOOXMLWriter.WriteBorderList(AStream: TStream); procedure WriteBorderStyle(AStream: TStream; AFormatRecord: PsCellFormat; ABorder: TsCellBorder; ABorderName: String); { border names found in xlsx files for Excel selections: "thin", "hair", "dotted", "dashed", "dashDotDot", "dashDot", "mediumDashDotDot", "slantDashDot", "mediumDashDot", "mediumDashed", "medium", "thick", "double" } var styleName: String; colorStr: String; rgb: TsColor; begin if (ABorder in AFormatRecord^.Border) then begin // Line style styleName := LINESTYLE_TYPES[AFormatRecord^.BorderStyles[ABorder].LineStyle]; // Border color rgb := AFormatRecord^.BorderStyles[ABorder].Color; colorStr := ColorToHTMLColorStr(rgb, true); AppendToStream(AStream, Format( '<%s style="%s">', [ABorderName, styleName, colorStr, ABorderName] )); end else AppendToStream(AStream, Format( '<%s />', [ABorderName])); end; var i: Integer; diag: String; begin AppendToStream(AStream, Format( '', [Length(FBorderList)])); // index 0 -- built-in "no borders" AppendToStream(AStream, '', '', ''); for i:=1 to High(FBorderList) do begin diag := ''; if (cbDiagUp in FBorderList[i]^.Border) then diag := diag + ' diagonalUp="1"'; if (cbDiagDown in FBorderList[i]^.Border) then diag := diag + ' diagonalDown="1"'; AppendToStream(AStream, ''); WriteBorderStyle(AStream, FBorderList[i], cbWest, 'left'); WriteBorderStyle(AStream, FBorderList[i], cbEast, 'right'); WriteBorderStyle(AStream, FBorderList[i], cbNorth, 'top'); WriteBorderStyle(AStream, FBorderList[i], cbSouth, 'bottom'); // OOXML uses the same border style for both diagonals. In agreement with // the biff implementation we select the style from the diagonal-up line. WriteBorderStyle(AStream, FBorderList[i], cbDiagUp, 'diagonal'); AppendToStream(AStream, ''); end; AppendToStream(AStream, ''); end; procedure TsSpreadOOXMLWriter.WriteCFCellRule(AStream: TStream; ARule: TsCFCellRule; ARange: TsCellRange; APriority: Integer); const FORMULA: array[cfcBeginsWith..cfcNextMonth] of String = ( 'LEFT(%0:s,LEN("%1:s"))="%1:s"', // cfcBeginsWith 'RIGHT(%0:s,Len("%1:s"))="%1:s"', // cfcEndsWidth 'NOT(ISERROR(SEARCH("%1:s",%0:s)))', // cfcContainsText 'ISERROR(SEARCH("%1:s",%0:s))', // cfcNotContainsText 'ISERROR(%0:s)', // cfcContainsErrors 'NOT(ISERROR(%0:s))', // cfcNotContainsErrors 'FLOOR(%s,1)=TODAY()-1', // cfcYesterday 'FLOOR(%s,1)=TODAY()', // cfcToday 'FLOOR(%s,1)=TODAY()+1', // cfcTomorrow 'AND(TODAY()-FLOOR(%0:s,1)<=6,FLOOR(%0:s,1)<=TODAY())', // cfcLast7Days 'AND(TODAY()-ROUNDDOWN(%0:s,0)>=(WEEKDAY(TODAY())),TODAY()-ROUNDDOWN(%0:s,0)<(WEEKDAY(TODAY())+7))', // cfcLastWeek 'AND(TODAY()-ROUNDDOWN(%0:s,0)<=WEEKDAY(TODAY())-1,ROUNDDOWN(%0:s,0)-TODAY()<=7-WEEKDAY(TODAY()))', // cfcThisWeek 'AND(ROUNDDOWN(%0:s,0)-TODAY()>(7-WEEKDAY(TODAY())),ROUNDDOWN(C15,0)-TODAY()<(15-WEEKDAY(TODAY())))', // cfcNextWeek 'AND(MONTH(%0:s)=MONTH(EDATE(TODAY(),0-1)),YEAR(%0:s)=YEAR(EDATE(TODAY(),0-1)))', // cfcLastMonth 'AND(MONTH(%0:s)=MONTH(TODAY()),YEAR(%0:s)=YEAR(TODAY()))', // cfcThisMonth 'AND(MONTH(%0:s)=MONTH(EDATE(TODAY(),0+1)),YEAR(%0:s)=YEAR(EDATE(TODAY(),0+1)))' // cfcNextMonth ); var i: Integer; dxfID: Integer; typeStr, opStr, formula1Str, formula2Str, param1Str, param2Str, param3Str: String; firstCellOfRange: String; s: String; begin dxfID := -1; for i := 0 to High(FDifferentialFormatIndexList) do if FDifferentialFormatIndexList[i] = ARule.FormatIndex then begin dxfID := i; break; end; typeStr := CF_TYPE_NAMES[ARule.Condition]; if CF_OPERATOR_NAMES[ARule.Condition] = '' then opStr := '' else opStr := ' operator="' + CF_OPERATOR_NAMES[ARule.Condition] + '"'; formula1Str := ''; formula2Str := ''; param1Str := ''; param2Str := ''; param3Str := ''; case ARule.Condition of cfcEqual..cfcNotBetween: begin s := CFOperandToStr(ARule.Operand1); formula1Str := Format('%s', [s]); if (ARule.Condition in [cfcBetween, cfcNotBetween]) then begin s := CFOperandToStr(ARule.Operand2); formula2Str := Format('%s', [s]); end; end; cfcAboveAverage..cfcBelowEqualAverage: begin if (ARule.Condition in [cfcBelowAverage, cfcBelowEqualAverage]) then param1Str := ' aboveAverage="0"'; if (ARule.Condition in [cfcAboveEqualAverage, cfcBelowEqualAverage]) then param2Str := ' equalAverage="1"'; if VarIsNumeric(ARule.Operand1) or (ARule.Operand1 = 0) then param3Str := Format(' stdDev="%g"', [double(ARule.Operand1)]); end; cfcTop, cfcBottom, cfcTopPercent, cfcBottomPercent: begin // // = bottom 30 percent if ARule.Condition in [cfcBottom, cfcBottomPercent] then param1Str := ' bottom="1"'; if ARule.Condition in [cfcTopPercent, cfcBottomPercent] then param2Str := ' percent="1"'; param3Str := ' rank="' + VarToStr(ARule.Operand1) + '"'; end; cfcDuplicate, cfcUnique: ; cfcBeginsWith..cfcNotContainsErrors: begin firstCellOfRange := GetCellString(ARange.Row1, ARange.Col1); formula1Str := '' + Format(FORMULA[ARule.Condition], [firstcellOfRange, ARule.Operand1]) + ''; param1Str := ' text="' + VarToStr(ARule.Operand1) + '"'; end; cfcYesterday..cfcNextMonth: begin firstCellOfrange := GetCellString(ARange.Row1, ARange.Col1); s := Format(FORMULA[ARule.Condition], [firstcellOfRange]); formula1Str := '' + s + ''; param1Str := Format(' timePeriod="%s"', [CF_OPERATOR_NAMES[ARule.Condition]]); opStr := ''; end; cfcLastYear..cfcNextYear: begin firstCellOfRange := GetCellString(ARange.Row1, ARange.Col1); s := Format(CF_YEAR_FORMULAS[ARule.Condition], [firstCellOfRange]); formula1Str := '' + s + ''; end; cfcExpression: begin s := ARule.Operand1; if (s <> '') and (s[1] = '=') then Delete(s, 1, 1); formula1Str := '' + s + ''; end; else FWorkbook.AddErrorMsg('ConditionalFormat operator not supported.'); end; if formula1Str = '' then s := Format( '', [ typeStr, dxfId, APriority, opStr, param1Str, param2Str, param3Str ]) else s := Format( '' + '%s%s' + '', [ typeStr, dxfId, APriority, opStr, param1Str, param2Str, param3Str, formula1Str, formula2Str ]); AppendToStream(AStream, s); end; procedure TsSpreadOOXMLWriter.WriteCFColorRangeRule(AStream: TStream; ARule: TsCFColorRangeRule; APriority: Integer); { example: } begin AppendToStream(AStream, '' + ''); AppendToStream(AStream, CF_ValueNode(ARule.StartValueKind, ARule.StartValue), IfThen(ARule.ThreeColors, CF_ValueNode(ARule.CenterValueKind, ARule.CenterValue), ''), CF_ValueNode(ARule.EndValueKind, ARule.EndValue) ); AppendToStream(AStream, CF_ColorNode(ARule.StartColor), IfThen(ARule.ThreeColors, CF_ColorNode(ARule.CenterColor), ''), CF_ColorNode(ARule.EndColor) ); AppendToStream(AStream, '' + ''); end; procedure TsSpreadOOXMLWriter.WriteCFDatabarRule(AStream: TStream; ARule: TsCFDataBarRule; APriority: Integer); { example from test file: {A620EE03-2FEC-4D54-872C-66BDB99CB07E} } begin AppendToStream(AStream, '' + ''); AppendToStream(AStream, CF_ValueNode(ARule.StartValueKind, ARule.StartValue), CF_ValueNode(ARule.EndValueKind, ARule.EndValue), CF_ColorNode(ARule.Color) ); AppendToStream(AStream, '' + ''); end; procedure TsSpreadOOXMLWriter.WriteCFIconSetRule(AStream: TStream; ARule: TsCFIconSetRule; APriority: Integer); { } var i: Integer; begin AppendToStream(AStream, Format( '' + '' + '', [ APriority, CF_ICON_SET[Arule.IconSet] ])); for i := 0 to ARule.IconCount-2 do AppendToStream(AStream, CF_ValueNode(ARule.ValueKinds[i], ARule.Values[i]) ); AppendToStream(AStream, '' + ''); end; procedure TsSpreadOOXMLWriter.WriteColBreaks(AStream: TStream; AWorksheet: TsBasicWorksheet); var sheet: TsWorksheet absolute AWorksheet; n: Integer; i: Integer; begin n := 0; for i := 0 to sheet.Cols.Count - 1 do if (croPageBreak in PCol(sheet.Cols[i])^.Options) then inc(n); if n = 0 then exit; AppendToStream(AStream, Format( '', [n, n])); for i := 0 to sheet.Cols.Count - 1 do if (croPageBreak in PCol(sheet.Cols[i])^.Options) then AppendToStream(AStream, Format( '', [PCol(sheet.Cols[i])^.Col])); AppendToStream(AStream, ''); end; procedure TsSpreadOOXMLWriter.WriteCols(AStream: TStream; AWorksheet: TsBasicWorksheet); var lCol: PCol; c: Integer; w: Single; customWidth: String; customStyle: String; sheet: TsWorksheet absolute AWorksheet; hiddenStr: String; begin AppendToStream(AStream, ''); for c:=0 to sheet.GetLastColIndex do begin customWidth := ''; customStyle := ''; lCol := sheet.FindCol(c); // The column width is needed in suChars here. w := sheet.ReadDefaultColWidth(suChars); hiddenStr := ''; if lCol <> nil then begin if lCol^.ColWidthType = cwtCustom then begin w := (FWorkbook as TsWorkbook).ConvertUnits(lCol^.Width, FWorkbook.Units, suChars); customWidth := 'customWidth="1" '; end; if lCol^.FormatIndex > 0 then customStyle := Format('style="%d" ', [lCol^.FormatIndex]); if (croHidden in lCol^.Options) then hiddenStr := ' hidden="1"'; end; AppendToStream(AStream, Format( '', [c+1, c+1, w, customWidth, customStyle, hiddenStr], FPointSeparatorSettings) ); end; AppendToStream(AStream, ''); end; procedure TsSpreadOOXMLWriter.WriteComments(AWorksheet: TsBasicWorksheet); var comment: PsComment; txt: String; begin if (AWorksheet as TsWorksheet).Comments.Count = 0 then exit; // Create the comments stream SetLength(FSComments, FCurSheetNum + 1); FSComments[FCurSheetNum] := CreateTempStream(FWorkbook, Format('fpsCMNT%d', [FCurSheetNum])); // Header AppendToStream(FSComments[FCurSheetNum], XML_HEADER); AppendToStream(FSComments[FCurSheetNum], Format( '', [SCHEMAS_SPREADML])); AppendToStream(FSComments[FCurSheetNum], ''+ ''+ // Not necessary to specify an author here. But the node must exist! ''); AppendToStream(FSComments[FCurSheetNum], ''); // Comments for comment in (AWorksheet as TsWorksheet).Comments do begin txt := comment^.Text; ValidXMLText(txt); // Write comment text to Comments stream AppendToStream(FSComments[FCurSheetNum], Format( '', [GetCellString(comment^.Row, comment^.Col)]) + ''+ ''+ ''+ // thie entire node could be omitted, but then Excel uses some ugly default font ''+ ''+ // Excel files have color index 81 here, but it could be that this does not exist in fps files --> use rgb instead ''+ // It is not harmful to Excel if the font does not exist. ''+ ''+ '' + txt + '' + '' + '' + ''); end; // Footer AppendToStream(FSComments[FCurSheetNum], ''); AppendToStream(FSComments[FCurSheetNum], ''); end; procedure TsSpreadOOXMLWriter.WriteConditionalFormat(AStream: TStream; AFormat: TsConditionalFormat; var APriority: Integer); var rangeStr: String; i: Integer; rule: TsCFRule; begin with AFormat.CellRange do rangeStr := GetCellRangeString(Row1, Col1, Row2, Col2,rfAllRel, true); AppendToStream(AStream, Format( '', [rangeStr])); for i := 0 to AFormat.RulesCount-1 do begin rule := AFormat.Rules[i]; if rule is TsCFCellRule then WriteCFCellRule(AStream, TsCFCellRule(rule), AFormat.CellRange, APriority) else if rule is TsCFColorRangeRule then WriteCFColorRangeRule(AStream, TsCFColorRangeRule(rule), APriority) else if rule is TsCFDataBarRule then WriteCFDataBarRule(AStream, TsCFDataBarRule(rule), APriority) else if rule is TsCFIconSetRule then WriteCFIconSetRule(AStream, TsCFIconSetRule(rule), APriority) else exit; dec(APriority); end; AppendToStream(AStream, ''); end; procedure TsSpreadOOXMLWriter.WriteConditionalFormats(AStream: TStream; AWorksheet: TsBasicWorksheet); var book: TsWorkbook; worksheet: TsWorksheet absolute AWorksheet; i: Integer; CF: TsConditionalFormat; priority: Integer = 0; ncf: Integer; begin book := TsWorkbook(FWorkbook); ncf := book.GetNumConditionalFormats; if ncf = 0 then exit; for i := 0 to ncf-1 do begin CF := book.GetConditionalFormat(i); if CF.Worksheet = AWorksheet then inc(priority, CF.RulesCount); end; for i := 0 to ncf-1 do begin CF := book.GetConditionalFormat(i); if CF.Worksheet = AWorksheet then WriteConditionalFormat(AStream, CF, priority); end; end; procedure TsSpreadOOXMLWriter.WriteCustomMetaData(AStream: TStream); var book: TsWorkbook; i: Integer; id: Integer; begin book := TsWorkbook(FWorkbook); if book.MetaData.Custom.Count = 0 then exit; AppendToStream(AStream, ''); id := 2; for i := 0 to book.MetaData.Custom.Count-1 do begin AppendToStream(AStream, Format( '' + '%s' + '', [ id, book.MetaData.Custom.Names[i], book.MetaData.Custom.ValueFromIndex[i] ])); inc(id); end; AppendToStream(AStream, ''); end; procedure TsSpreadOOXMLWriter.WriteDimension(AStream: TStream; AWorksheet: TsBasicWorksheet); var r1,c1,r2,c2: Cardinal; dim: String; begin GetSheetDimensions(AWorksheet, r1, r2, c1, c2); if (r1=r2) and (c1=c2) then dim := GetCellString(r1, c1) else dim := GetCellRangeString(r1, c1, r2, c2); AppendToStream(AStream, Format( '', [dim])); end; procedure TsSpreadOOXMLWriter.WriteFillList(AStream: TStream); var i: Integer; pt, bc, fc: string; begin AppendToStream(AStream, Format( '', [Length(FFillList)])); // index 0 -- built-in empty fill AppendToStream(AStream, '', '', ''); // index 1 -- built-in gray125 pattern AppendToStream(AStream, '', '', ''); // user-defined fills for i:=2 to High(FFillList) do begin pt := PATTERN_TYPES[FFillList[i]^.Background.Style]; if FFillList[i]^.Background.FgColor = scTransparent then fc := 'auto="1"' else fc := Format('rgb="%s"', [Copy(ColorToHTMLColorStr(FFillList[i]^.Background.FgColor), 2, MaxInt)]); if FFillList[i]^.Background.BgColor = scTransparent then bc := 'auto="1"' else bc := Format('rgb="%s"', [Copy(ColorToHTMLColorStr(FFillList[i]^.Background.BgColor), 2, MaxInt)]); AppendToStream(AStream, ''); AppendToStream(AStream, Format( '', [pt]) + Format( '', [fc]) + Format( '', [bc]) + // '' + '' + ''); end; AppendToStream(FSStyles, ''); end; { Writes font parameters to the stream. ATag is "font" for the entry in "styles.xml", or "rPr" for the entry for richtext parameters in the shared string list. ANameTag is "name" for the entry in "styles.xml", or "rFont" for the entry} procedure TsSpreadOOXMLWriter.WriteFont(AStream: TStream; AFont: TsFont; UseInStyleNode: Boolean); const TAG: Array[boolean] of string = ('rPr', 'font'); NAME_TAG: Array[boolean] of String = ('rFont', 'name'); var s: String; begin s := ''; s := s + Format('', [AFont.Size], FPointSeparatorSettings); s := s + Format('<%s val="%s" />', [NAME_TAG[UseInStyleNode], AFont.FontName]); if (fssBold in AFont.Style) then s := s + ''; if (fssItalic in AFont.Style) then s := s + ''; if (fssUnderline in AFont.Style) then s := s + ''; if (fssStrikeout in AFont.Style) then s := s + ''; if AFont.Color <> scBlack then s := s + Format('', [Copy(ColorToHTMLColorStr(AFont.Color), 2, MaxInt)]); case AFont.Position of fpSubscript : s := s + ''; fpSuperscript: s := s + ''; end; AppendToStream(AStream, Format( '<%s>%s', [TAG[UseInStyleNode], s, TAG[UseInStyleNode]])); end; { Writes the fontlist of the workbook to the stream. } procedure TsSpreadOOXMLWriter.WriteFontList(AStream: TStream); var i: Integer; font: TsFont; book: TsWorkbook; begin book := FWorkbook as TsWorkbook; AppendToStream(AStream, Format( '', [book.GetFontCount])); for i:=0 to book.GetFontCount-1 do begin font := book.GetFont(i); WriteFont(AStream, font, true); end; AppendToStream(AStream, ''); end; procedure TsSpreadOOXMLWriter.WriteHeaderFooter(AStream: TStream; AWorksheet: TsBasicWorksheet); var s: String; begin with (AWorksheet as TsWorksheet).PageLayout do begin if not (HasHeader or HasFooter) then exit; s := ''; if poDifferentFirst in Options then s := s + ' differentFirst="1"'; if poDifferentOddEven in Options then s := s + ' differentOddEven="1"'; AppendToStream(AStream, ''); if Headers[HEADER_FOOTER_INDEX_ODD] <> '' then AppendToStream(AStream, '' + UTF8TextToXMLText(Headers[HEADER_FOOTER_INDEX_ODD]) + ''); if Footers[HEADER_FOOTER_INDEX_ODD] <> '' then AppendToStream(AStream, '' + UTF8TextToXMLText(Footers[HEADER_FOOTER_INDEX_ODD]) + ''); if poDifferentFirst in (AWorksheet as TsWorksheet).PageLayout.Options then begin if Headers[HEADER_FOOTER_INDEX_FIRST] <> '' then AppendToStream(AStream, '' + UTF8TextToXMLText(Headers[HEADER_FOOTER_INDEX_FIRST]) + ''); if Footers[HEADER_FOOTER_INDEX_FIRST] <> '' then AppendToStream(AStream, '' + UTF8TextToXMLText(Footers[HEADER_FOOTER_INDEX_FIRST]) + ''); end; if poDifferentOddEven in Options then begin AppendToStream(AStream, '' + UTF8TextToXMLText(Headers[HEADER_FOOTER_INDEX_EVEN]) + ''); AppendToStream(AStream, '' + UTF8TextToXMLText(Footers[HEADER_FOOTER_INDEX_EVEN]) + ''); end; AppendToStream(AStream, ''); end; end; procedure TsSpreadOOXMLWriter.WriteHyperlinks(AStream: TStream; AWorksheet: TsBasicWorksheet; rId: Integer); var hyperlink: PsHyperlink; target, bookmark: String; s: String; txt: String; AVLNode: TAvgLvlTreeNode; sheet: TsWorksheet absolute AWorksheet; begin if sheet.Hyperlinks.Count = 0 then exit; AppendToStream(AStream, ''); AVLNode := sheet.Hyperlinks.FindLowest; while AVLNode <> nil do begin hyperlink := PsHyperlink(AVLNode.Data); SplitHyperlink(hyperlink^.Target, target, bookmark); s := Format('ref="%s"', [GetCellString(hyperlink^.Row, hyperlink^.Col)]); if target <> '' then begin s := Format('%s r:id="rId%d"', [s, rId]); inc(rId); end; if bookmark <> '' then //target = '' then s := Format('%s location="%s"', [s, bookmark]); txt := UTF8TextToXMLText(sheet.ReadAsText(hyperlink^.Row, hyperlink^.Col)); if (txt <> '') and (txt <> hyperlink^.Target) then s := Format('%s display="%s"', [s, txt]); if hyperlink^.ToolTip <> '' then begin txt := hyperlink^.Tooltip; ValidXMLText(txt); s := Format('%s tooltip="%s"', [s, txt]); end; AppendToStream(AStream, ''); AVLNode := sheet.Hyperlinks.FindSuccessor(AVLNode); end; AppendToStream(AStream, ''); end; procedure TsSpreadOOXMLWriter.WriteMergedCells(AStream: TStream; AWorksheet: TsBasicWorksheet); var rng: PsCellRange; n: Integer; begin n := (AWorksheet as TsWorksheet).MergedCells.Count; if n = 0 then exit; AppendToStream(AStream, Format( '', [n]) ); for rng in (AWorksheet as TsWorksheet).MergedCells do AppendToStream(AStream, Format( '', [GetCellRangeString(rng^.Row1, rng^.Col1, rng^.Row2, rng^.Col2)])); AppendToStream(AStream, ''); end; { Writes all number formats to the stream. Saving starts at the item with the FirstFormatIndexInFile. } procedure TsSpreadOOXMLWriter.WriteNumFormatList(AStream: TStream); var i, n: Integer; numFmtStr: String; xmlStr: String; parser: TsNumFormatParser; begin xmlStr := ''; n := 0; for i:= FFirstNumFormatIndexInFile to NumFormatList.Count-1 do begin numFmtStr := NumFormatList[i]; parser := TsExcelNumFormatParser.Create(numFmtStr, Workbook.FormatSettings); try numFmtStr := UTF8TextToXMLText(parser.FormatString); xmlStr := xmlStr + Format('', [i, numFmtStr]); inc(n); finally parser.Free; end; end; if n > 0 then AppendToStream(AStream, Format( '', [n]), xmlStr, '' ); end; { In older versions, the workbook had a color palette which was written here. Now there is no palette any more. } procedure TsSpreadOOXMLWriter.WritePalette(AStream: TStream); begin // just keep it here in case we'd need it later... Unused(AStream); end; procedure TsSpreadOOXMLWriter.WritePageMargins(AStream: TStream; AWorksheet: TsBasicWorksheet); begin with (AWorksheet as TsWorksheet).PageLayout do AppendToStream(AStream, Format( '', [ mmToIn(LeftMargin), mmToIn(RightMargin), mmToIn(TopMargin), mmToIn(BottomMargin), mmToIn(HeaderMargin), mmToIn(FooterMargin) ], FPointSeparatorSettings )); end; procedure TsSpreadOOXMLWriter.WritePageSetup(AStream: TStream; AWorksheet: TsBasicWorksheet); var s: String; i: Integer; sheet: TsWorksheet absolute AWorksheet; begin s := ''; // Paper size for i:=0 to High(PAPER_SIZES) do if (SameValue(PAPER_SIZES[i,0], sheet.PageLayout.PageHeight) and SameValue(PAPER_SIZES[i,1], sheet.PageLayout.PageWidth)) or (SameValue(PAPER_SIZES[i,1], sheet.PageLayout.PageHeight) and SameValue(PAPER_SIZES[i,0], sheet.PageLayout.PageWidth)) then begin s := Format('%s paperSize="%d"', [s, i]); break; end; if poFitPages in sheet.PageLayout.Options then begin // Fit width to pages s := Format('%s fitToWidth="%d"', [s, sheet.PageLayout.FitWidthToPages]); // Fit height to pages s := Format('%s fitToHeight="%d"', [s, sheet.PageLayout.FitHeightToPages]); end else // Scaling factor s := Format('%s scale="%d"', [s, sheet.PageLayout.ScalingFactor]); // Orientation s := Format('%s orientation="%s"', [ s, IfThen(sheet.PageLayout.Orientation = spoPortrait, 'portrait', 'landscape') ]); // First page number if poUseStartPageNumber in sheet.PageLayout.Options then s := Format('%s useFirstPageNumber="1"', [s]); s := Format('%s firstPageNumber="%d"', [s, sheet.PageLayout.StartPageNumber]); // Print order if poPrintPagesByRows in sheet.PageLayout.Options then s := s + ' pageOrder="overThenDown"'; // Monochrome if poMonochrome in sheet.PageLayout.Options then s := s + ' blackAndWhite="1"'; // Quality if poDraftQuality in sheet.PageLayout.Options then s := s + ' draft="1"'; if s <> '' then AppendToStream(AStream, ''); end; procedure TsSpreadOOXMLWriter.WritePrintOptions(AStream: TStream; AWorksheet: TsBasicWorksheet); var s: String; begin s := ''; if poPrintGridLines in (AWorksheet as TsWorksheet).PageLayout.Options then s := s + ' gridLines="1"'; if poPrintHeaders in (AWorksheet as TsWorksheet).PageLayout.Options then s := s + ' headings="1"'; if s <> '' then AppendToStream(AStream, ''); end; procedure TsSpreadOOXMLWriter.WriteRowBreaks(AStream: TStream; AWorksheet: TsBasicWorksheet); var i, n: Integer; sheet: TsWorksheet absolute AWorksheet; begin n := 0; for i := 0 to sheet.Rows.Count-1 do if (croPageBreak in PRow(sheet.Rows[i])^.Options) then inc(n); if n = 0 then exit; AppendToStream(AStream, Format( '', [n, n])); for i := 0 to sheet.Rows.Count - 1 do if (croPageBreak in PRow(sheet.Rows[i])^.Options) then AppendToStream(AStream, Format( '', [PRow(sheet.Rows[i])^.Row])); AppendToStream(AStream, ''); end; procedure TsSpreadOOXMLWriter.WriteSheetData(AStream: TStream; AWorksheet: TsBasicWorksheet); var r, r1, r2: Cardinal; c, c1, c2: Cardinal; row: PRow; value: Variant; lCell: TCell; styleCell: PCell; cell: PCell; s: String; sheet: TsWorksheet; book: TsWorkbook; begin book := FWorkbook as TsWorkbook; sheet := AWorksheet as TsWorksheet; AppendToStream(AStream, ''); GetSheetDimensions(AWorksheet, r1, r2, c1, c2); if (boVirtualMode in Workbook.Options) then begin if Assigned(sheet.OnWriteCellData) and (sheet.VirtualColCount > 0) and (sheet.VirtualRowCount > 0) then begin for r := 0 to r2 do begin row := sheet.FindRow(r); s := ''; if row <> nil then begin s := s + Format(' ht="%.2f"', [book.ConvertUnits(row^.Height, book.Units, suPoints)], FPointSeparatorSettings ); if row^.RowHeightType = rhtCustom then s := s + ' customHeight="1"'; if row^.FormatIndex > 0 then s := s + Format(' s="%d" customFormat="1"', [row^.FormatIndex]); if (croHidden in row^.Options) then s := s + ' hidden="1"'; end; AppendToStream(AStream, Format( '', [r+1, sheet.VirtualColCount, s])); for c := 0 to c2 do begin lCell.Row := r; // to silence a compiler hint InitCell(lCell); value := varNull; styleCell := nil; sheet.OnWriteCellData(sheet, r, c, value, styleCell); if styleCell <> nil then lCell := styleCell^; lCell.Row := r; lCell.Col := c; if VarIsNull(value) then begin if styleCell <> nil then lCell.ContentType := cctEmpty else Continue; end else if VarIsNumeric(value) then begin lCell.ContentType := cctNumber; lCell.NumberValue := value; end else if VarType(value) = varDate then begin lCell.ContentType := cctDateTime; lCell.DateTimeValue := StrToDateTime(VarToStr(value), Workbook.FormatSettings); // was: StrToDate end else if VarIsStr(value) then begin lCell.ContentType := cctUTF8String; lCell.UTF8StringValue := VarToStrDef(value, ''); end else if VarIsBool(value) then begin lCell.ContentType := cctBool; lCell.BoolValue := value <> 0; end; WriteCellToStream(AStream, @lCell); varClear(value); end; AppendToStream(AStream, ''); end; end; end // end of virtual mode writing else begin // The cells need to be written in order, row by row, cell by cell for r := r1 to r2 do begin // If the row has a custom or auto height and/or custom format // then add them to the specification row := sheet.FindRow(r); s := ''; if row <> nil then begin s := s + Format(' ht="%.2f"', [book.ConvertUnits(row^.Height, book.Units, suPoints)], FPointSeparatorSettings ); if row^.RowHeightType = rhtCustom then s := s + ' customHeight="1"'; if row^.FormatIndex > 0 then s := s + Format(' s="%d" customFormat="1"', [row^.FormatIndex]); if (croHidden in row^.Options) then s := s + ' hidden="1"'; end; AppendToStream(AStream, Format( '', [r+1, c1+1, c2+1, s])); // Write cells belonging to this row. { // Strange: the RowEnumerator is very slow here... ?! for cell in AWorksheet.Cells.GetRowEnumerator(r) do WriteCellToStream(AStream, cell); } for c := c1 to c2 do begin cell := sheet.FindCell(r, c); if Assigned(cell) then WriteCellToStream(AStream, cell); end; AppendToStream(AStream, ''); end; end; AppendToStream(AStream, ''); end; procedure TsSpreadOOXMLWriter.WriteSheetFormatPr(AStream: TStream; AWorksheet: TsBasicWorksheet); var w, h: Single; begin // Excel has column width in characters, and row heights in pts. w := (AWorksheet as TsWorksheet).ReadDefaultColWidth(suChars); h := (AWorksheet as TsWorksheet).ReadDefaultRowHeight(suPoints); AppendToStream(AStream, Format( '', [w, h], FPointSeparatorSettings)); end; procedure TsSpreadOOXMLWriter.WriteSheetPr(AStream: TStream; AWorksheet: TsBasicWorksheet); var s: String; sheet: TsWorksheet absolute AWorksheet; begin s := ''; if (sheet.PageLayout.FitWidthToPages > 0) or (sheet.PageLayout.FitHeightToPages > 0) then s := s + ' fitToPage="1"'; if s <> '' then s := ''; if sheet.TabColor <> scNotDefined then s := s + Format('', [Copy(ColorToHTMLColorStr(sheet.TabColor), 2, MaxInt)]); if s <> '' then AppendToStream(AStream, '' + s + ''); end; procedure TsSpreadOOXMLWriter.WriteSheetProtection(AStream: TStream; AWorksheet: TsBasicWorksheet); var s: String; sheet: TsWorksheet absolute AWorksheet; begin s := ''; // No attribute -> attr="0" if sheet.IsProtected then s := ' sheet="1" scenarios="1"' else Exit; //exit if sheet not protected if sheet.CryptoInfo.PasswordHash <> '' then begin if sheet.CryptoInfo.Algorithm = caExcel then s := s + ' password="' + sheet.CryptoInfo.PasswordHash + '"' else begin s := s + ' hashValue="' + sheet.CryptoInfo.PasswordHash + '"'; if sheet.CryptoInfo.Algorithm <> caUnknown then s := s + ' algorithmName="' + AlgorithmToStr(sheet.CryptoInfo.Algorithm, auExcel) + '"'; if sheet.CryptoInfo.SaltValue <> '' then s := s + ' saltValue="' + sheet.CryptoInfo.SaltValue + '"'; if sheet.CryptoInfo.SpinCount <> 0 then s := s + ' spinCount="' + IntToStr(sheet.CryptoInfo.SpinCount) + '"'; end; end; if spObjects in sheet.Protection then s := s + ' objects="1"'; { if spScenarios in sheet.Protection then // to do: Remove from default above s := s + ' scenarios="1"'; } if spSelectLockedCells in sheet.Protection then s := s + ' selectLockedCells="1"'; if spSelectUnlockedCells in sheet.Protection then s := s + ' selectUnlockedCells="1"'; // No attribute -> attr="1" { if not (spAutoFilter in sheet.Protection) then s := s + ' autoFilter="0"'; } if not (spDeleteColumns in sheet.Protection) then s := s + ' deleteColumns="0"'; if not (spDeleteRows in sheet.Protection) then s := s + ' deleteRows="0"'; if not (spFormatCells in sheet.Protection) then s := s + ' formatCells="0"'; if not (spFormatColumns in sheet.Protection) then s := s + ' formatColumns="0"'; if not (spFormatRows in sheet.Protection) then s := s + ' formatRows="0"'; if not (spInsertColumns in sheet.Protection) then s := s + ' insertColumns="0"'; if not (spInsertHyperlinks in sheet.Protection) then s := s + ' insertHyperlinks="0"'; if not (spInsertRows in sheet.Protection) then s := s + ' insertRows="0"'; { if not (spPivotTables in sheet.Protection) then s := s + ' pivotTables="0"'; } if not (spSort in sheet.Protection) then s := s + ' sort="0"'; if s <> '' then AppendToStream(AStream, ''); end; procedure TsSpreadOOXMLWriter.WriteSheets(AStream: TStream); var counter: Integer; sheet: TsWorksheet; sheetName: String; sheetState: String; begin AppendToStream(AStream, ''); for counter := 1 to (Workbook as TsWorkbook).GetWorksheetCount do begin sheet := (Workbook as TsWorkbook).GetWorksheetByIndex(counter-1); sheetname := UTF8TextToXMLText(sheet.Name); sheetState := IfThen(soHidden in sheet.Options, ' state="hidden"', ''); AppendToStream(AStream, Format( '', [sheetname, counter, counter, sheetstate])); end; AppendToStream(AStream, ''); end; procedure TsSpreadOOXMLWriter.WriteSheetViews(AStream: TStream; AWorksheet: TsBasicWorksheet); const ZOOM_EPS = 1E-3; var showGridLines: String; showHeaders: String; topRightCell: String; bottomLeftCell: String; bottomRightCell: String; actCell: String; tabSel: String; bidi: String; zoomscale: String; attr: String; windowProtection: String; book: TsWorkbook; sheet: TsWorksheet absolute AWorksheet; begin book := FWorkbook as TsWorkbook; // Show gridlines ? showGridLines := StrUtils.IfThen(soShowGridLines in sheet.Options, '', ' showGridLines="0"'); // Show headers? showHeaders := StrUtils.IfThen(soShowHeaders in sheet.Options, '', ' showRowColHeaders="0"'); // Zoom factor if boWriteZoomFactor in FWorkbook.Options then zoomscale := StrUtils.IfThen(SameValue(sheet.ZoomFactor, 1.0, ZOOM_EPS), '', Format(' zoomScale="%.0f"', [sheet.ZoomFactor*100])) else zoomscale := ''; // BiDiMode case sheet.BiDiMode of bdDefault: bidi := ''; bdLTR : bidi := ' rightToLeft="0"'; bdRTL : bidi := ' rightToLeft="1"'; end; // Active cell if (sheet.ActiveCellRow <> cardinal(-1)) and (sheet.ActiveCellCol <> cardinal(-1)) then actCell := GetCellString(sheet.ActiveCellRow, sheet.ActiveCellCol) else actCell := ''; // Selected tab? tabSel := StrUtils.IfThen(sheet = book.ActiveWorksheet, ' tabSelected="1"', ''); // Window protection if (soPanesProtection in sheet.Options) and book.IsProtected then windowProtection := ' windowProtection="1"' else windowProtection := ''; // All SheetView attributes attr := windowProtection + showGridLines + showHeaders + tabSel + zoomScale + bidi; // No frozen panes if not (soHasFrozenPanes in sheet.Options) or ((sheet.LeftPaneWidth = 0) and (sheet.TopPaneHeight = 0)) then begin if actCell = '' then actCell := 'A1'; AppendToStream(AStream, Format( '' + '' + '' + '' + '', [ attr, actCell, actCell ])) end else begin // Frozen panes topRightCell := GetCellString(0, sheet.LeftPaneWidth, [rfRelRow, rfRelCol]); bottomLeftCell := GetCellString(sheet.TopPaneHeight, 0, [rfRelRow, rfRelCol]); bottomRightCell := GetCellString(sheet.TopPaneHeight, sheet.LeftPaneWidth, [rfRelRow, rfRelCol]); if (sheet.LeftPaneWidth > 0) and (sheet.TopPaneHeight > 0) then begin if actCell = '' then actCell := bottomRightcell; AppendToStream(AStream, Format( '' + ''+ '' + '' + '' + '' + '' + '', [ attr, sheet.LeftPaneWidth, sheet.TopPaneHeight, bottomRightCell, topRightCell, topRightCell, bottomLeftCell, bottomLeftCell, actCell, actCell ])) end else if (sheet.LeftPaneWidth > 0) then begin if actCell = '' then actCell := topRightCell; AppendToStream(AStream, Format( '' + ''+ '' + '' + '' + '', [ attr, sheet.LeftPaneWidth, topRightCell, actCell, actCell ])) end else if (sheet.TopPaneHeight > 0) then begin if actCell = '' then actCell := bottomLeftCell; AppendToStream(AStream, Format( ''+ ''+ ''+ '' + ''+ '', [ attr, sheet.TopPaneHeight, bottomLeftCell, actCell, actCell ])); end; end; end; procedure TsSpreadOOXMLWriter.WriteStyle(AStream: TStream; ANodeName: String; AFormat: PsCellFormat); var s: String; sAlign: String; sProtected: String; book: TsWorkbook; numFmtParams: TsNumFormatParams; numFmtStr: String; fontID: Integer; fillID: Integer; borderID: Integer; idx: Integer; begin book := TsWorkbook(FWorkbook); s := ''; sAlign := ''; sProtected := ''; { Number format } if (uffNumberFormat in AFormat^.UsedFormattingFields) then begin numFmtParams := book.GetNumberFormat(AFormat^.NumberFormatIndex); if numFmtParams <> nil then begin numFmtStr := numFmtParams.NumFormatStr; idx := NumFormatList.IndexOf(numFmtStr); end else idx := 0; // "General" format is at index 0 s := s + Format('numFmtId="%d" applyNumberFormat="1" ', [idx]); end else s := s + 'numFmtId="0" '; { Font } fontId := 0; if (uffFont in AFormat^.UsedFormattingFields) then fontID := AFormat^.FontIndex; s := s + Format('fontId="%d" ', [fontId]); if fontID > 0 then s := s + 'applyFont="1" '; if ANodeName = 'xf' then s := s + 'xfId="0" '; // if ANodeName = 'cellXfs' then s := s + 'xfId="0" '; { Text rotation } if (uffTextRotation in AFormat^.UsedFormattingFields) then case AFormat^.TextRotation of trHorizontal: ; rt90DegreeClockwiseRotation: sAlign := sAlign + Format('textRotation="%d" ', [180]); rt90DegreeCounterClockwiseRotation: sAlign := sAlign + Format('textRotation="%d" ', [90]); rtStacked: sAlign := sAlign + Format('textRotation="%d" ', [255]); end; { Text alignment } if (uffHorAlign in AFormat^.UsedFormattingFields) and (AFormat^.HorAlignment <> haDefault) then case AFormat^.HorAlignment of haLeft : sAlign := sAlign + 'horizontal="left" '; haCenter: sAlign := sAlign + 'horizontal="center" '; haRight : sAlign := sAlign + 'horizontal="right" '; end; if (uffVertAlign in AFormat^.UsedFormattingFields) and (AFormat^.VertAlignment <> vaDefault) then case AFormat^.VertAlignment of vaTop : sAlign := sAlign + 'vertical="top" '; vaCenter: sAlign := sAlign + 'vertical="center" '; vaBottom: sAlign := sAlign + 'vertical="bottom" '; end; { Word wrap } if (uffWordWrap in AFormat^.UsedFormattingFields) then sAlign := sAlign + 'wrapText="1" '; { BiDi mode } if (uffBiDi in Aformat^.UsedFormattingFields) and (AFormat^.BiDiMode <> bdDefault) then sAlign := sAlign + Format('readingOrder="%d" ', [Ord(AFormat^.BiDiMode)]); if sAlign <> '' then begin s := s + 'applyAlignment="1" '; sAlign := ''; end; { Fill } if (uffBackground in AFormat^.UsedFormattingFields) then begin fillID := FindFillInList(AFormat); if fillID = -1 then fillID := 0; s := s + Format('fillId="%d" applyFill="1" ', [fillID]); end; { Border } if (uffBorder in AFormat^.UsedFormattingFields) then begin borderID := FindBorderInList(AFormat); if borderID = -1 then borderID := 0; s := s + Format('borderId="%d" applyBorder="1" ', [borderID]); end; { Protection } if not (cpLockCell in AFormat^.Protection) then sProtected := 'locked="0" '; if (cpHideFormulas in AFormat^.Protection) then sProtected := sProtected + 'hidden="1" '; if sProtected <> '' then begin s := s + 'applyProtection="1" '; sProtected := ''; end; { Write everything to stream } if (sAlign = '') and (sProtected = '') then AppendToStream(AStream, Format('<%s %s />', [ANodeName, s])) else AppendToStream(AStream, Format('<%s %s>', [ANodeName, s]), sAlign + sProtected, Format('', [ANodeName])); end; { Writes the style list which the workbook has collected in its FormatList } procedure TsSpreadOOXMLWriter.WriteStyleList(AStream: TStream; ANodeName: String); var fmt: PsCellFormat; i: Integer; book: TsWorkbook; begin book := FWorkbook as TsWorkbook; AppendToStream(AStream, Format( '<%s count="%d">', [ANodeName, book.GetNumCellFormats])); for i:=0 to book.GetNumCellFormats-1 do begin fmt := book.GetPointerToCellFormat(i); WriteStyle(AStream, 'xf', fmt); end; AppendToStream(FSStyles, Format( '', [ANodeName])); end; procedure TsSpreadOOXMLWriter.WriteDrawings(AWorksheet: TsBasicWorksheet); var i: Integer; img: TsImage; r1, c1, r2, c2: Cardinal; roffs1, coffs1, roffs2, coffs2: Double; x, y, w, h: Double; descr: String; hlink: String; xdr_cNvPr: String; rId: Integer; book: TsWorkbook; sheet: TsWorksheet absolute AWorksheet; begin if sheet.GetImageCount= 0 then exit; book := FWorkbook as TsWorkbook; SetLength(FSDrawings, FCurSheetNum + 1); FSDrawings[FCurSheetNum] := CreateTempStream(FWorkbook, Format('fpsD%d', [FCurSheetNum])); // Header AppendToStream(FSDrawings[FCurSheetNum], XML_HEADER, ''); // Repeat for each image rId := 1; for i:=0 to sheet.GetImageCount - 1 do begin img := sheet.GetImage(i); if book.GetEmbeddedObj(img.Index).ImageType = itUnknown then Continue; sheet.CalcImageExtent(i, true, r1, c1, r2, c2, roffs1, coffs1, roffs2, coffs2, // mm x, y, w, h); // mm; descr := ExtractFileName(book.GetEmbeddedObj(img.index).Filename); if descr = '' then descr := 'image'; // This part defines the relationship to the graphic and, if available, to // a hyperlink. xdr_cNvPr := Format('id="%d" name="Graphic %d" descr="%s"', [i+3,i+2, descr]); if img.HyperlinkTarget <> '' then begin hlink := Format(' '' then hlink := hlink + Format('tooltip="%s" ', [img.HyperlinkToolTip]); hlink := hlink + '/>'; xdr_cNvPr := '' + hlink + ''; end else xdr_cNvPr := ''; AppendToStream(FSDrawings[FCurSheetNum], ''); AppendToStream(FSDrawings[FCurSheetNum], Format( ''+ '%d' + '%d'+ '%d'+ '%d'+ '', [ c1, mmToEMU(coffs1), r1, mmToEMU(roffs1) ])); AppendToStream(FSDrawings[FCurSheetNum], Format( ''+ '%d'+ '%d'+ '%d'+ '%d'+ '', [ c2, mmToEMU(coffs2), r2, mmToEMU(roffs2) ])); AppendToStream(FSDrawings[FCurSheetNum], Format( ''+ ''+ xdr_cNvPr + ''+ ''+ ''+ ''+ ''+ ''+ ''+ ''+ ''+ ''+ '' + ''+ '' + '' + // size in EMU ''+ ''+ ''+ ''+ ''+ '' + '', [ // i + 3, i+2, descr, SCHEMAS_DOC_RELS, rId, mmToEMU(x), mmToEMU(y), mmToEMU(w), mmToEMU(h) ])); AppendToStream(FSDrawings[FCurSheetNum], ''); inc(rId, 1); end; AppendToStream(FSDrawings[FCurSheetNum], ''); end; // For each sheet, writes a "drawingX.xml.rels" file to // folder "../drawings/_rels". X matches the (1-base) sheet index. // See also: WriteVmlDrawingRels procedure TsSpreadOOXMLWriter.WriteDrawingRels(AWorksheet: TsBasicWorksheet); var i: Integer; ext: String; img: TsImage; rId: Integer; target, bookmark: String; u: TURI; sheet: TsWorksheet absolute AWorksheet; begin if (sheet.GetImageCount = 0) then exit; SetLength(FSDrawingsRels, FCurSheetNum + 1); FSDrawingsRels[FCurSheetNum] := CreateTempStream(FWorkbook, Format('fpsDR%d', [FCurSheetNum])); // Header AppendToStream(FSDrawingsRels[FCurSheetNum], XML_HEADER + LineEnding, '' + LineEnding); // Repeat for each image rId := 1; for i:=0 to sheet.GetImageCount - 1 do begin img := sheet.GetImage(i); if img.HyperlinkTarget <> '' then begin SplitHyperlink(img.HyperlinkTarget, target, bookmark); if (target <> '') and (pos('file:', target) = 0) then begin u := ParseURI(target); if u.Protocol = '' then target := '../' + target; end; if (bookmark <> '') then target := target + '#' + bookmark; AppendToStream(FSDrawingsRels[FCurSheetNum], Format( ' ' + LineEnding, [ rId, SCHEMAS_HYPERLINK, target ])); inc(rId); end; ext := GetImageTypeExt((FWorkbook as TsWorkbook).GetEmbeddedObj(img.Index).Imagetype); AppendToStream(FSDrawingsRels[FCurSheetNum], Format( ' ' + LineEnding, [ rId, SCHEMAS_IMAGE, img.Index+1, ext ])); inc(rId); end; AppendToStream(FSDrawingsRels[FCurSheetNum], ''); end; (* procedure TsSpreadOOXMLWriter.WriteDrawingsOfSheet(AStream: TStream; AWorksheet: TsWorksheet; rId: Integer); // Use stream FSDrawingS[sheetindex] var i: Integer; AVLNode: TAVLTreeNode; hyperlink: PsHyperlink; target, bookmark: String; begin // Keep in sync with WriteWorksheetRels ! FNext_rID := IfThen(AWorksheet.Comments.Count = 0, 1, 3); AVLNode := AWorksheet.Hyperlinks.FindLowest; while AVLNode <> nil do begin inc(FNext_rID); AVLNode := AWorksheet.Hyperlinks.FindSuccessor(AVLNode); end; for i:=0 to AWorksheet.GetImageCount-1 do begin AppendToStream(AStream, Format( '', [FNext_rId])); inc(FNext_rId); end; end; *) {@ ----------------------------------------------------------------------------- Writes a VmlDrawings file for the specified worksheet. This file contains information on drawing of shapes etc. Currently fpspreadsheet supports only comments and embedded header/footer images. Each worksheet writes a vmlDrawing file if it contains comments or header/footer images. All comments are packed into the same file, all images as well. The comments file is written first, the Images file next. All files are numbered consecutively for ALL sheets. Example vmlDrawing1.vml --> Sheet 1 comments vmlDrawing2.vml --> Sheet 1 header/footer images vmlDrawing3.vml --> Sheet 2 header/footer images vmlDrawing4.vml --> Sheet 3 comments -------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.WriteVmlDrawings(AWorksheet: TsBasicWorksheet); begin // At first write the VmlDrawings related to comments WriteVmlDrawings_Comments(AWorksheet); // Now write the vmlDrawings related to headers/footers WriteVmlDrawings_HeaderFooterImages(AWorksheet); end; procedure TsSpreadOOXMLWriter.WriteVMLDrawings_Comments( AWorksheet: TsBasicWorksheet); var comment: PsComment; fileindex: Integer; index: Integer; id: Integer; begin if (AWorksheet as TsWorksheet).Comments.Count = 0 then exit; fileIndex := Length(FSVmlDrawings); SetLength(FSVmlDrawings, fileIndex+1); FSVmlDrawings[fileIndex] := CreateTempStream(FWorkbook, Format('fpsVMLD%', [fileIndex+1])); // Header of file AppendToStream(FSVmlDrawings[fileIndex], '' + LineEnding); // My xml viewer does not format vml files property --> format in code. AppendToStream(FSVmlDrawings[fileIndex], ' ' + LineEnding + ' ' + LineEnding + // "data" is a comma-separated list with the ids of groups of 1024 comments -- really? ' ' + LineEnding); AppendToStream(FSVmlDrawings[fileIndex], ' '+LineEnding+ ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding); // Write vmlDrawings for each comment (formatting and position of comment box) index := 1; for comment in (AWorksheet as TsWorksheet).Comments do begin id := 1024*(FCurSheetNum+1) + index; // if more than 1024 comments then use data="1,2,etc" above! -- not implemented yet AppendToStream(FSVmlDrawings[fileIndex], LineEnding + Format( ' ' + LineEnding); end; // Footer of file AppendToStream(FSVmlDrawings[fileIndex], ''); end; (* *) procedure TsSpreadOOXMLWriter.WriteVMLDrawings_HeaderFooterImages( AWorksheet: TsBasicWorksheet); var book: TsWorkbook; sheet: TsWorksheet absolute AWorksheet; { AName = 'header' or 'footer' ATag = 'L', 'C', 'R', 'x', or ' ' AChar = 'H' or 'F' } procedure Process(AStream: TStream; AName: String; ATag, AChar: Char; AImage: TsHeaderFooterImage; var id, index: Integer); var fn: String; begin if AImage.Index = -1 then exit; if ATag = 'x' then begin book.AddErrorMsg(rsOnlyOneHeaderFooterImageAllowed, [AName]); exit; end; if ATag = ' ' then begin book.AddErrorMsg(rsIncorrectPositionOfImageInHeaderFooter, [AName]); exit; end; fn := ChangeFileExt(book.GetEmbeddedObj(AImage.Index).FileName, ''); if fn = '' then fn := 'image'; AppendToStream(AStream, Format( ' ' + LineEnding + // e.g. z-index:1 ' ' + LineEnding + // e.g. "rId1" "arrow_down" ' ' + LineEnding + ' ' + LineEnding, [ ATag + AChar, id, index, index, fn ])); inc(id); inc(index); end; var fileindex: Integer; id, index: Integer; tagIndex: Integer; img: TsHeaderFooterImage; sec: TsHeaderFooterSectionIndex; headerTags, footerTags: String; begin book := FWorkbook as TsWorkbook; if not sheet.PageLayout.HasHeaderFooterImages then exit; fileIndex := Length(FSVmlDrawings); SetLength(FSVmlDrawings, fileIndex+1); FSVmlDrawings[fileIndex] := CreateTempStream(FWorkbook, Format('fpsVMLD%d', [fileIndex+1])); // Header of file AppendToStream(FSVmlDrawings[fileIndex], ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding); index := 1; id := 1024 * (FCurSheetNum+1) + index; sheet.PageLayout.GetImageSections(headerTags, footerTags); // Write the data for the image in each section of the header for sec in TsHeaderFooterSectionIndex do begin tagIndex := ord(sec) + 1; img := sheet.PageLayout.HeaderImages[sec]; Process(FSVmlDrawings[fileIndex], rsHeader, headerTags[tagIndex], 'H', img, id, index); end; // Repeat with footer for sec in TsHeaderFooterSectionIndex do begin img := sheet.PageLayout.FooterImages[sec]; tagIndex := ord(sec) + 1; Process(FSVmlDrawings[fileIndex], rsFooter, footerTags[tagIndex], 'F', img, id, index); end; // Footer of file AppendToStream(FSVmlDrawings[fileIndex], ''); end; { } {@@ ---------------------------------------------------------------------------- Writes a relationship file (*.rels) for a vmlDrawing.xml file to a media file. Destination folder will be "../drawings/_rels". Needed for header/footer images. Note: vmlDrawing files of comments do not have a correspondig rels file. The index of the rels file must match that of the vmlDrawingX.vml file. -------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.WriteVmlDrawingRels(AWorksheet: TsBasicWorksheet); var fileindex: Integer; sec: TsHeaderFooterSectionIndex; rId: Integer; img: TsHeaderFooterImage; ext: String; sheet: TsWorksheet absolute AWorksheet; begin if not sheet.PageLayout.HasHeaderFooterImages then exit; fileIndex := Length(FSVmlDrawingsRels); if sheet.Comments.Count > 0 then inc(fileIndex); // skip comments for numbering SetLength(FSVmlDrawingsRels, fileIndex+1); FsVmlDrawingsRels[fileIndex] := CreateTempStream(FWorkbook, Format('fpsVMSDR%d', [fileIndex])); // Write file header AppendToStream(FSVmlDrawingsRels[fileIndex], '' + LineEnding + '' + LineEnding ); // Write entry for each header/footer image // Note: use same order as for writing of VmlDrawing files. rId := 1; // Write the data for the image in each section of the header for sec in TsHeaderFooterSectionIndex do begin img := sheet.PageLayout.HeaderImages[sec]; if img.Index = -1 then continue; ext := GetImageTypeExt((FWorkbook as TsWorkbook).GetEmbeddedObj(img.Index).ImageType); // imgIdx := FWorkbook.FindEmbeddedObj(imgName); AppendToStream(FSVmlDrawingsRels[fileIndex], Format( ' ' + LineEnding, [ rId, // Id="rID1" img.Index + 1, ext // Target="../media/image1.png" ])); inc(rId); end; // Repeat with footer for sec in TsHeaderFooterSectionIndex do begin img := sheet.PageLayout.FooterImages[sec]; if img.Index = -1 then continue; ext := GetImageTypeExt((FWorkbook as TsWorkbook).GetEmbeddedObj(img.Index).Imagetype); AppendToStream(FSVmlDrawingsRels[fileIndex], Format( ' ', [ rId, img.Index + 1, ext ])); inc(rId); end; // Write file footer AppendToStream(FSVmlDrawingsRels[fileIndex], ''); end; procedure TsSpreadOOXMLWriter.WriteWorksheetRels(AWorksheet: TsBasicWorksheet); var AVLNode: TAvgLvlTreeNode; hyperlink: PsHyperlink; s: String; target, bookmark: String; rId_Comments, rId_Hyperlink, rId_Drawing, rId_DrawingHF: Integer; sheet: TsWorksheet absolute AWorksheet; begin // Extend stream array // NOTE: If no .rels file is written for this sheet at least an empty stream // must be provided to keep the numbering intact. SetLength(FSSheetRels, FCurSheetNum + 1); // Anything to write? if (sheet.Comments.Count = 0) and (sheet.Hyperlinks.Count = 0) and (sheet.GetImageCount = 0) and not (sheet.PageLayout.HasHeaderFooterImages) then exit; Get_rId(AWorksheet, rID_Comments, rId_Hyperlink, rId_Drawing, rId_DrawingHF); // Create stream FSSheetRels[FCurSheetNum] := CreateTempStream(FWorkbook, Format('fpsWSR%d', [FCurSheetNum])); // Header AppendToStream(FSSheetRels[FCurSheetNum], XML_HEADER + LineEnding); AppendToStream(FSSheetRels[FCurSheetNum], Format( '' + LineEnding, [SCHEMAS_RELS])); // Relationships for comments if sheet.Comments.Count > 0 then begin AppendToStream(FSSheetRels[FCurSheetNum], Format( ' ' + LineEnding, [rId_Comments+1, FCurSheetNum+1, SCHEMAS_COMMENTS])); AppendToStream(FSSheetRels[FCurSheetNum], Format( ' ' + LineEnding, [rId_Comments, vmlDrawingCounter, SCHEMAS_VMLDRAWING])); inc(vmlDrawingCounter); end; // Relationships for hyperlinks if sheet.Hyperlinks.Count > 0 then begin AVLNode := sheet.Hyperlinks.FindLowest; while Assigned(AVLNode) do begin hyperlink := PsHyperlink(AVLNode.Data); SplitHyperlink(hyperlink^.Target, target, bookmark); if target <> '' then begin if (pos('file:', target) = 0) and FileNameIsAbsolute(target) then FileNameToURI(target); s := Format('Id="rId%d" Target="%s" TargetMode="External" Type="%s"', [rId_Hyperlink, target, SCHEMAS_HYPERLINK]); AppendToStream(FSSheetRels[FCurSheetNum], ' ' + LineEnding); inc(rId_Hyperlink); end; AVLNode := sheet.Hyperlinks.FindSuccessor(AVLNode); end; end; // Relationships for embedded images // relationship with to the ../drawings/drawingX.xml file containing all // image infos. X is the 1-base sheet index if sheet.GetImageCount > 0 then AppendToStream(FSSheetRels[FCurSheetNum], Format( ' ' + LineEnding, [rId_Drawing, FCurSheetNum + 1, SCHEMAS_DRAWING] )); // Relationships for embedded header/footer images if sheet.PageLayout.HasHeaderFooterImages then begin AppendToStream(FSSheetRels[FCurSheetnum], Format( ' ' + LineEnding, [rId_DrawingHF, vmlDrawingCounter, SCHEMAS_VMLDRAWING])); inc(vmlDrawingCounter); end; // Footer AppendToStream(FSSheetRels[FCurSheetNum], ''); end; procedure TsSpreadOOXMLWriter.WriteGlobalFiles; begin { --- Content Types --- } // Will be written at the end of WriteToStream when all Sheet.rels files are // known { --- meta data ---- } WriteMetaData(FSMetaData); WriteCustomMetaData(FSCustomMetaData); { --- _rels/.rels --- } AppendToStream(FSRelsRels, XML_HEADER + LineEnding); AppendToStream(FSRelsRels, Format( '' + LineEnding, [SCHEMAS_RELS])); AppendToStream(FSRelsRels, Format( '' + LineEnding, [SCHEMAS_DOCUMENT])); AppendToStream(FSRelsRels, Format( '' + LineEnding, [SCHEMAS_META_CORE])); if TsWorkbook(FWorkbook).MetaData.Custom.Count > 0 then AppendToStream(FSRelsRels, Format( '' + LineEnding, [SCHEMAS_META_CUSTOM])); AppendToStream(FSRelsRels, ''); { --- xl/styles --- } AppendToStream(FSStyles, XML_Header); AppendToStream(FSStyles, Format( '', [SCHEMAS_SPREADML])); // Number formats WriteNumFormatList(FSStyles); // Fonts WriteFontList(FSStyles); // Fill patterns WriteFillList(FSStyles); // Borders WriteBorderList(FSStyles); // Style records AppendToStream(FSStyles, '' + '' + '' ); WriteStyleList(FSStyles, 'cellXfs'); // Cell style records AppendToStream(FSStyles, '' + '' + ''); // Conditional format styles WriteDifferentialFormats(FSStyles); // Misc AppendToStream(FSStyles, ''); // Palette WritePalette(FSStyles); AppendToStream(FSStyles, ''); end; { Write folder "media" with embedded streams } procedure TsSpreadOOXMLWriter.WriteMedia(AZip: TZipper); var i: Integer; stream: TMemoryStream; embObj: TsEmbeddedObj; embName: String; ext: String; book: TsWorkbook; begin book := FWorkbook as TsWorkbook; for i:=0 to book.GetEmbeddedObjCount-1 do begin embObj := book.GetEmbeddedObj(i); stream := embObj.Stream; stream.Position := 0; ext := GetImageTypeExt(embObj.ImageType); embName := Format('image%d.%s', [i+1, ext]); AZip.Entries.AddFileEntry(stream, OOXML_PATH_XL_MEDIA + embname); end; end; procedure TsSpreadOOXMLWriter.WriteMetaData(AStream: TStream); { test file meta data äöü Donald Duck this is a comment_x000d_ in two lines äöü. Donald Duck 2015-06-05T18:19:34Z 2020-07-27T21:23:27Z } var book: TsWorkbook; s: String; dt: TDateTime; begin book := TsWorkbook(FWorkbook); AppendToStream(AStream, XML_HEADER); AppendToStream(AStream, ''); if book.MetaData.Title <> '' then AppendToStream(AStream, Format( '%s', [UTF8TextToXMLText(book.MetaData.Title)])); if book.MetaData.Subject <> '' then AppendToStream(AStream, Format( '%s', [UTF8TextToXMLText(book.Metadata.Subject)])); if book.MetaData.CreatedBy <> '' then AppendToStream(AStream, Format( '%s', [UTF8TextToXMLText(book.MetaData.CreatedBy)])); if book.MetaData.Keywords.Count > 0 then begin s := book.MetaData.KeyWords.CommaText; AppendToStream(AStream, Format( '%s', [s])); end; if book.MetaData.Comments.Count > 0 then begin s := book.MetaData.Comments.Text; while (s <> '') and (s[Length(s)] in [#10, #13]) do Delete(s, Length(s), 1); s := StringReplace(s, LineEnding, '_x000d_', [rfReplaceAll]); AppendToStream(AStream, Format( '%s', [s])); end; if book.MetaData.LastModifiedBy <> '' then begin s := book.MetaData.LastModifiedBy; AppendToStream(AStream, Format( '%s', [s])); // to do: check xml entities end; if book.MetaData.DateCreated > 0 then begin dt := book.MetaData.DateCreated + GetLocalTimeOffset / MinsPerDay; s := FormatDateTime(ISO8601FormatExtendedUTC, dt); AppendToStream(AStream, Format( '%s', [s])); end; if book.MetaData.DateLastModified >0 then begin dt := book.MetaData.DateLastModified + GetLocalTimeOffset / MinsPerDay; s := FormatDateTime(ISO8601FormatExtendedUTC, dt); AppendToStream(AStream, Format( '%s', [s])); end; AppendToStream(AStream, ''); end; { } procedure TsSpreadOOXMLWriter.WriteContent; var i: Integer; begin { Global workbook data - Mark all sheets } WriteWorkbook(FSWorkbook); { Preparation for shared strings } FSharedStringsCount := 0; { Write all worksheets which fills also the shared strings. Also: write comments, Drawings, vmlDrawings and relationship files } for i := 0 to (Workbook as TsWorkbook).GetWorksheetCount - 1 do begin FWorksheet := (Workbook as TsWorkbook).GetWorksheetByIndex(i); WriteWorksheet(FWorksheet); WriteComments(FWorksheet); WriteVmlDrawings(FWorksheet); WriteVmlDrawingRels(FWorksheet); WriteDrawings(FWorksheet); WriteDrawingRels(FWorksheet); WriteWorksheetRels(FWorksheet); end; { Finalization of the shared strings document } if FSharedStringsCount > 0 then begin AppendToStream(FSSharedStrings_complete, XML_HEADER, Format( '', [ SCHEMAS_SPREADML, FSharedStringsCount, FSharedStringsCount ])); ResetStream(FSSharedStrings); FSSharedStrings_complete.CopyFrom(FSSharedStrings, FSSharedStrings.Size); AppendToStream(FSSharedStrings_complete, ''); end; { Workbook relations - Mark relation to all sheets } WriteWorkbookRels(FSWorkbookRels); end; procedure TsSpreadOOXMLWriter.WriteContentTypes; var i,j: Integer; imgext: TStringList; ext: String; sheet: TsWorksheet; book: TsWorkbook; begin book := FWorkbook as TsWorkbook; AppendToStream(FSContentTypes, XML_HEADER + LineEnding); AppendToStream(FSContentTypes, '' + LineEnding); AppendToStream(FSContentTypes, Format( '' + LineEnding, [MIME_RELS])); AppendToStream(FSContentTypes, Format( '' + LineEnding, [MIME_XML])); AppendToStream(FSContentTypes, Format( '' + LineEnding, [MIME_VMLDRAWING])); if book.GetEmbeddedObjCount > 0 then begin imgExt := TStringList.Create; try for i:=0 to book.GetEmbeddedObjCount-1 do begin ext := GetImageTypeExt(book.GetEmbeddedObj(i).ImageType); j := imgExt.IndexOf(ext); if j = -1 then imgExt.Add(ext); end; for i := 0 to imgExt.Count-1 do AppendToStream(FSContentTypes, Format( '' + LineEnding, [imgExt[i], imgExt[i]])); finally imgExt.Free; end; end; AppendToStream(FSContentTypes, '' + LineEnding); for i:=1 to book.GetWorksheetCount do begin AppendToStream(FSContentTypes, Format( '' + LineEnding, [i, MIME_WORKSHEET])); sheet := book.GetWorksheetByIndex(i-1); if sheet.GetImageCount > 0 then AppendToStream(FSContentTypes, Format( '' + LineEnding, [i, MIME_DRAWING])); end; for i:=1 to Length(FSComments) do AppendToStream(FSContentTypes, Format( '' + LineEnding, [i, MIME_COMMENTS])); AppendToStream(FSContentTypes, '' + LineEnding); AppendToStream(FSContentTypes, '' + LineEnding); AppendToStream(FSContentTypes, ''); if book.MetaData.Custom.Count > 0 then AppendToStream(FSContentTypes, ''); AppendToStream(FSContentTypes, ''); end; procedure TsSpreadOOXMLWriter.WriteDefinedNames(AStream: TStream); var sheet: TsWorksheet; stotal, srng, sheetname: String; i, j: Integer; prng: TsCellRange; firstIndex, lastIndex: Integer; begin stotal := ''; // Write print ranges and repeatedly printed rows and columns for i := 0 to (Workbook as TsWorkbook).GetWorksheetCount-1 do begin sheet := (Workbook as TsWorkbook).GetWorksheetByIndex(i); sheetname := '''' + UTF8TextToXMLText(sheet.Name) + ''''; // Cell block of print range srng := ''; for j := 0 to sheet.PageLayout.NumPrintRanges - 1 do begin prng := sheet.PageLayout.GetPrintRange(j); srng := srng + ',' + Format('%s!%s', [ sheetname, GetCellRangeString(prng.Row1, prng.Col1, prng.Row2, prng.Col2, []) ]); end; if srng <> '' then begin Delete(srng, 1, 1); stotal := stotal + Format( '%s', [i, srng] ); end; // repeated columns ... srng := ''; if sheet.PageLayout.RepeatedCols.FirstIndex <> UNASSIGNED_ROW_COL_INDEX then begin firstindex := sheet.PageLayout.RepeatedCols.FirstIndex; lastindex := IfThen(sheet.PageLayout.RepeatedCols.LastIndex = UNASSIGNED_ROW_COL_INDEX, firstindex, sheet.PageLayout.RepeatedCols.LastIndex); srng := srng + ',' + Format('%s!$%s:$%s', [sheetname, GetColString(firstindex), GetColString(lastindex)]); end; // ... and repeated rows if sheet.PageLayout.RepeatedRows.FirstIndex <> UNASSIGNED_ROW_COL_INDEX then begin firstindex := sheet.PageLayout.RepeatedRows.FirstIndex; lastindex := IfThen(sheet.PageLayout.RepeatedRows.LastIndex = UNASSIGNED_ROW_COL_INDEX, firstindex, sheet.PageLayout.RepeatedRows.LastIndex); srng := srng + ',' + Format('%s!$%d:$%d', [sheetname, firstindex+1, lastindex+1]); end; if srng <> '' then begin Delete(srng, 1,1); stotal := stotal + Format( '%s', [i, srng] ); end; end; // Write to stream if any defined names exist if stotal <> '' then AppendtoStream(AStream, '' + stotal + ''); end; procedure TsSpreadOOXMLWriter.WriteDifferentialFormat(AStream: TStream; AFormat: PsCellFormat); procedure WriteBorderStyle(AStream: TStream; AFormatRecord: PsCellFormat; ABorder: TsCellBorder; ABorderName: String); { border names found in xlsx files for Excel selections: "thin", "hair", "dotted", "dashed", "dashDotDot", "dashDot", "mediumDashDotDot", "slantDashDot", "mediumDashDot", "mediumDashed", "medium", "thick", "double" } var styleName: String; colorStr: String; rgb: TsColor; begin if (ABorder in AFormatRecord^.Border) then begin // Line style styleName := LINESTYLE_TYPES[AFormatRecord^.BorderStyles[ABorder].LineStyle]; // Border color rgb := AFormatRecord^.BorderStyles[ABorder].Color; colorStr := ColorToHTMLColorStr(rgb, true); AppendToStream(AStream, Format( '<%s style="%s">', [ABorderName, styleName, colorStr, ABorderName] )); end else AppendToStream(AStream, Format( '<%s />', [ABorderName])); end; var pt, bc, fc, diag: string; // font: TsFont; nfp: TsNumFormatParams; nfs: String; nfi: Integer; nfId: String; begin AppendToStream(AStream, ''); { font } // TODO: Fix font handling: although correct in syntax something seems to be missing... if (uffFont in AFormat^.UsedFormattingFields) then begin FWorkbook.AddErrorMsg('Writing conditional font not supported by XLSX writer.'); { font := TsWorkbook(FWorkbook).GetFont(AFormat^.FontIndex); if font <> nil then begin AppendToStream(AStream, ''); if font.Color <> scNotDefined then AppendToStream(AStream, Format('', [fc] )); if fssBold in font.Style then AppendToStream(AStream, ''); if fssItalic in font.Style then AppendToStream(AStream, ''); if fssStrikeout in font.Style then AppendToStream(AStream, ''); // Font name, font size, and style underline not supported AppendToStream(AStream, ''); end; } end; { number format } if (uffNumberFormat in AFormat^.UsedFormattingFields) then begin nfp := TsWorkbook(FWorkbook).GetNumberFormat(AFormat^.NumberFormatIndex); // nfs := UTF8TextToXMLText(nfp.NumFormatStr); nfs := nfp.NumFormatStr; nfi := FNumFormatList.IndexOf(nfs); if nfi > -1 then nfId := Format('numFmtId="%d" ', [nfi]) else nfId := ''; AppendToStream(AStream, Format('', [nfId, nfs])); end; { background fill } if (uffBackground in AFormat^.UsedFormattingFields) then begin pt := PATTERN_TYPES[AFormat^.Background.Style]; if AFormat^.Background.FgColor <> scTransparent then fc := Format('rgb="%s"', [Copy(ColorToHTMLColorStr(AFormat^.Background.FgColor), 2, MaxInt)]); if AFormat^.Background.BgColor = scTransparent then bc := 'auto="1"' else bc := Format('rgb="%s"', [Copy(ColorToHTMLColorStr(AFormat^.Background.BgColor), 2, MaxInt)]); AppendToStream(AStream, '' + Format( '', [pt]) + Format( '', [fc]) + Format( '', [bc]) + '' + ''); end; { cell borders } if (uffBorder in AFormat^.UsedFormattingFields) then begin diag := ''; if (cbDiagUp in AFormat^.Border) then diag := diag + ' diagonalUp="1"'; if (cbDiagDown in AFormat^.Border) then diag := diag + ' diagonalDown="1"'; AppendToStream(AStream, ''); WriteBorderStyle(AStream, AFormat, cbWest, 'left'); WriteBorderStyle(AStream, AFormat, cbEast, 'right'); WriteBorderStyle(AStream, AFormat, cbNorth, 'top'); WriteBorderStyle(AStream, AFormat, cbSouth, 'bottom'); // OOXML uses the same border style for both diagonals. In agreement with // the biff implementation we select the style from the diagonal-up line. WriteBorderStyle(AStream, AFormat, cbDiagUp, 'diagonal'); AppendToStream(AStream, ''); end; AppendToStream(AStream, ''); end; procedure TsSpreadOOXMLWriter.WriteDifferentialFormats(AStream: TStream); var book: TsWorkbook; i: Integer; fmtIndex: Integer; fmt: PsCellFormat; begin if Length(FDifferentialFormatIndexList) = 0 then begin AppendToStream(AStream, ''); exit; end; AppendToStream(AStream, Format( '', [Length(FDifferentialFormatIndexList)])); book := TsWorkbook(FWorkbook); for i := 0 to High(FDifferentialFormatIndexList) do begin fmtIndex := FDifferentialFormatIndexList[i]; fmt := book.GetPointerToCellFormat(fmtIndex); WriteDifferentialFormat(AStream, fmt); end; AppendToStream(AStream, ''); { AppendToStream(AStream, ''); } end; procedure TsSpreadOOXMLWriter.WriteWorkbook(AStream: TStream); begin AppendToStream(AStream, XML_HEADER); AppendToStream(AStream, Format( '', [SCHEMAS_SPREADML, SCHEMAS_DOC_RELS])); AppendToStream(AStream, ''); AppendToStream(AStream, ''); WriteWorkbookProtection(AStream); AppendToStream(AStream, '' + '' + ''); WriteSheets(AStream); WriteDefinedNames(AStream); AppendToStream(AStream, ''); AppendToStream(AStream, ''); end; procedure TsSpreadOOXMLWriter.WriteWorkbookProtection(AStream: TStream); var s: String; book: TsWorkbook; begin book := FWorkbook as TsWorkbook; s := ''; if book.CryptoInfo.PasswordHash <> '' then begin if book.CryptoInfo.Algorithm = caExcel then s := s + ' workbookPassword="' + book.CryptoInfo.PasswordHash + '"' else begin s:= s + ' workbookHashVal="' + book.CryptoInfo.PasswordHash + '"'; if book.CryptoInfo.Algorithm <> caUnknown then s:= s + ' workbookAlgorithmName="' + AlgorithmToStr(book.CryptoInfo.Algorithm, auExcel) + '"'; if book.CryptoInfo.SaltValue <> '' then s:= s + ' workbookSaltValue="' + book.CryptoInfo.SaltValue + '"'; if book.CryptoInfo.SpinCount <> 0 then s:= s + ' workbookSpinCount="' + IntToStr(book.CryptoInfo.SpinCount) + '"'; end; end; { if book.RevisionsCrypto.Password <> '' then s:= s + ' revisionsPassword="' + book.RevisionsCrypto.Password +'"' else if book.RevisionsCrypto.HashValue <> '' then begin s:= s + ' revisionsHashValue="' + book.RevisionsCrypto.HashValue +'"'; if book.RevisionsCrypto.AlgorithmName <> '' then s:= s + ' revisionsAlgorithm="' + book.RevisionsCrypto.AlgorithmName +'"'; if book.RevisionsCrypto.SaltValue <> '' then s:= s + ' revisionsSaltValue="' + book.RevisionsCrypto.SaltValue +'"'; if book.RevisionsCrypto.SpinCount <> 0 then s:= s + ' revisionsSpinCount="' + IntToStr( book.RevisionsCrypto.SpinCount ) +'"'; end; } if bpLockStructure in book.Protection then s := s + ' lockStructure="1"'; if bpLockWindows in book.Protection then s := s + ' lockWindows="1"'; if bpLockRevision in book.Protection then s := s + ' lockRevision="1"'; if s <> '' then AppendToStream(AStream, ''); end; procedure TsSpreadOOXMLWriter.WriteWorkbookRels(AStream: TStream); var counter: Integer; begin AppendToStream(AStream, XML_HEADER + LineEnding, '' + LineEnding); counter := 1; while counter <= (Workbook as TsWorkbook).GetWorksheetCount do begin AppendToStream(AStream, Format( ' ' + LineEnding, [counter, counter, SCHEMAS_WORKSHEET])); inc(counter); end; AppendToStream(AStream, Format( ' ' + LineEnding, [counter, SCHEMAS_STYLES])); inc(counter); if FSharedStringsCount > 0 then begin AppendToStream(AStream, Format( ' ' + LineEnding, [counter, SCHEMAS_STRINGS])); inc(counter); end; AppendToStream(AStream, ''); end; procedure TsSpreadOOXMLWriter.WriteWorksheet(AWorksheet: TsBasicWorksheet); var rId_Comments: Integer; rId_FirstHyperlink: Integer; rId_Drawing, rId_DrawingHF: Integer; begin FCurSheetNum := Length(FSSheets); SetLength(FSSheets, FCurSheetNum + 1); Get_rId(AWorksheet, rID_Comments, rId_FirstHyperlink, rId_Drawing, rId_DrawingHF); // Create the stream FSSheets[FCurSheetNum] := CreateTempStream(FWorkbook, Format('fpsSH%d', [FCurSheetNum])); // Header AppendToStream(FSSheets[FCurSheetNum], XML_HEADER); AppendToStream(FSSheets[FCurSheetNum], Format( '', [SCHEMAS_SPREADML, SCHEMAS_DOC_RELS])); WriteSheetPr(FSSheets[FCurSheetNum], AWorksheet); WriteDimension(FSSheets[FCurSheetNum], AWorksheet); WriteSheetViews(FSSheets[FCurSheetNum], AWorksheet); WriteSheetFormatPr(FSSheets[FCurSheetNum], AWorksheet); WriteCols(FSSheets[FCurSheetNum], AWorksheet); WriteSheetData(FSSheets[FCurSheetNum], AWorksheet); WriteSheetProtection(FSSheets[FCurSheetNum], AWorksheet); WriteMergedCells(FSSheets[FCurSheetNum], AWorksheet); WriteHyperlinks(FSSheets[FCurSheetNum], AWorksheet, rId_FirstHyperlink); WriteConditionalFormats(FSSheets[FCurSheetNum], AWorksheet); WritePrintOptions(FSSheets[FCurSheetNum], AWorksheet); WritePageMargins(FSSheets[FCurSheetNum], AWorksheet); WritePageSetup(FSSheets[FCurSheetNum], AWorksheet); WriteRowBreaks(FSSheets[FCurSheetNum], AWorksheet); WriteColBreaks(FSSheets[FCurSheetNum], AWorksheet); WriteHeaderFooter(FSSheets[FCurSheetNum], AWorksheet); { This item is required for all embedded images. There must be a matching file in "drawingX.xml" file in "../drawings" which contains the image-related data of all images in this sheet. The file in turn requires an entry "drawingX.xml.rels" in the drawings rels folder } if (AWorksheet as TsWorksheet).GetImageCount > 0 then AppendToStream(FSSheets[FCurSheetNum], Format( '', [rId_Drawing])); { This item is required for all comments of a worksheet. Comments have two entries in the sheet's .rels file, one for the "../comments.xml" file, and one for the "../drawings/vmlDrawingX.vml" file. The vmlDrawing file must have an entry "vmlDrawingX.vml.rels" in the drawings rels folder. } if (AWorksheet as TsWorksheet).Comments.Count > 0 then AppendToStream(FSSheets[FCurSheetNum], Format( '', [rId_Comments])); { This item is required for all images embedded to a header/footer. There must be a corresponding "vmlDrawingX.vml" file in "../drawings". } if (AWorksheet as TsWorksheet).PageLayout.HasHeaderFooterImages then AppendToStream(FSSheets[FCurSheetNum], Format( '', [rId_DrawingHF])); // Footer AppendToStream(FSSheets[FCurSheetNum], ''); end; {@@ ---------------------------------------------------------------------------- Adds the built-in number formats to the NumFormatList. -------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.AddBuiltinNumFormats; begin FFirstNumFormatIndexInFile := 164; AddBuiltInBiffFormats( FNumFormatList, Workbook.FormatSettings, FFirstNumFormatIndexInFile-1 ); end; {@@ ---------------------------------------------------------------------------- Creates the basic streams for the individual data files. Will be zipped into a single xlsx file. Other stream depending on the count of sheets will be created when needed. -------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.CreateStreams; begin FSContentTypes := CreateTempStream(FWorkbook, 'fpsCT'); FSRelsRels := CreateTempStream(FWorkbook, 'fpsRR'); FSWorkbookRels := CreateTempStream(FWorkbook, 'fpsWBR'); FSWorkbook := CreateTempStream(FWorkbook, 'fpsWB'); FSStyles := CreateTempStream(FWorkbook, 'fpsSTY'); FSSharedStrings := CreateTempStream(FWorkbook, 'fpsSS'); FSSharedStrings_complete := CreateTempStream(FWorkbook, 'fpsSSC'); FSMetaData := CreateTempStream(FWorkbook, 'fpsMETA'); FSCustomMetaData := CreateTempStream(FWorkbook, 'fpsCM'); { if boFileStream in FWorkbook.Options then begin FSContentTypes := TFileStream.Create(GetTempFileName('', 'fpsCT'), fmCreate); FSRelsRels := TFileStream.Create(GetTempFileName('', 'fpsRR'), fmCreate); FSWorkbookRels := TFileStream.Create(GetTempFileName('', 'fpsWBR'), fmCreate); FSWorkbook := TFileStream.Create(GetTempFileName('', 'fpsWB'), fmCreate); FSStyles := TFileStream.Create(GetTempFileName('', 'fpsSTY'), fmCreate); FSSharedStrings := TFileStream.Create(GetTempFileName('', 'fpsSS'), fmCreate); FSSharedStrings_complete := TFileStream.Create(GetTempFileName('', 'fpsSSC'), fmCreate); end else if (boBufStream in Workbook.Options) then begin FSContentTypes := TBufStream.Create(GetTempFileName('', 'fpsCT')); FSRelsRels := TBufStream.Create(GetTempFileName('', 'fpsRR')); FSWorkbookRels := TBufStream.Create(GetTempFileName('', 'fpsWBR')); FSWorkbook := TBufStream.Create(GetTempFileName('', 'fpsWB')); FSStyles := TBufStream.Create(GetTempFileName('', 'fpsSTY')); FSSharedStrings := TBufStream.Create(GetTempFileName('', 'fpsSS')); FSSharedStrings_complete := TBufStream.Create(GetTempFileName('', 'fpsSSC')); end else begin; FSContentTypes := TMemoryStream.Create; FSRelsRels := TMemoryStream.Create; FSWorkbookRels := TMemoryStream.Create; FSWorkbook := TMemoryStream.Create; FSStyles := TMemoryStream.Create; FSSharedStrings := TMemoryStream.Create; FSSharedStrings_complete := TMemoryStream.Create; end; } // FSSheets will be created when needed. end; {@@ ---------------------------------------------------------------------------- Destroys the streams that were created by the writer -------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.DestroyStreams; var stream: TStream; begin DestroyTempStream(FSCustomMetaData); DestroyTempStream(FSMetaData); DestroyTempStream(FSContentTypes); DestroyTempStream(FSRelsRels); DestroyTempStream(FSWorkbookRels); DestroyTempStream(FSWorkbook); DestroyTempStream(FSStyles); DestroyTempStream(FSSharedStrings); DestroyTempStream(FSSharedStrings_complete); for stream in FSSheets do DestroyTempStream(stream); SetLength(FSSheets, 0); for stream in FSComments do DestroyTempStream(stream); SetLength(FSComments, 0); for stream in FSSheetRels do DestroyTempStream(stream); SetLength(FSSheetRels, 0); for stream in FSVmlDrawings do DestroyTempStream(stream); SetLength(FSVmlDrawings, 0); for stream in FSVmlDrawingsRels do DestroyTempStream(stream); SetLength(FSVmlDrawingsRels, 0); for stream in FSDrawings do DestroyTempStream(stream); SetLength(FSDrawings, 0); for stream in FSDrawingsRels do DestroyTempStream(stream); Setlength(FSDrawings, 0); end; {@@ ---------------------------------------------------------------------------- Prepares a string formula for writing: Deletes the leading = sign and makes sure that it is a valid xml string. -------------------------------------------------------------------------------} function TsSpreadOOXMLWriter.PrepareFormula(const AFormula: String): String; begin Result := AFormula; if (Result <> '') and (Result[1] = '=') then Delete(Result, 1, 1); Result := UTF8TextToXMLText(Result) end; {@@ ---------------------------------------------------------------------------- Is called before zipping the individual file parts. Rewinds the streams. -------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.ResetStreams; var i: Integer; begin ResetStream(FSContentTypes); ResetStream(FSRelsRels); ResetStream(FSWorkbookRels); ResetStream(FSWorkbook); ResetStream(FSStyles); ResetStream(FSSharedStrings_complete); ResetStream(FSMetaData); ResetStream(FSCustomMetaData); for i:=0 to High(FSSheets) do ResetStream(FSSheets[i]); for i:=0 to High(FSSheetRels) do ResetStream(FSSheetRels[i]); for i:=0 to High(FSComments) do ResetStream(FSComments[i]); for i:=0 to High(FSVmlDrawings) do ResetStream(FSVmlDrawings[i]); for i:=0 to High(FSVmlDrawingsRels) do ResetStream(FSVmlDrawingsRels[i]); for i:=0 to High(FSDrawings) do ResetStream(FSDrawings[i]); for i:=0 to High(FSDrawingsRels) do ResetStream(FSDrawingsRels[i]); end; {@@ ---------------------------------------------------------------------------- Writes a string to a file. Helper convenience method. -------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.WriteStringToFile(AFileName, AString: string); var stream : TFileStream; S : String; begin stream := TFileStream.Create(AFileName, fmCreate); try S := AString; stream.WriteBuffer(Pointer(S)^, Length(S)); finally stream.Free; end; end; {@@ ---------------------------------------------------------------------------- Writes an OOXML document to a stream -------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.WriteToStream(AStream: TStream; AParams: TsStreamParams = []); var FZip: TZipper; i: Integer; begin Unused(AParams); vmlDrawingCounter := 1; { Analyze the workbook and collect all information needed } ListAllNumFormats; ListAllFills; ListAllBorders; ListAllDifferentialFormats; { Create the streams that will hold the file contents } CreateStreams; { Fill the streams with the contents of the files } WriteGlobalFiles; WriteContent; WriteContentTypes; // Stream positions must be at beginning, they were moved to end during adding of xml strings. ResetStreams; { Now compress the files } FZip := TZipper.Create; try FZip.FileName := GetTempFilename; // needed if the zipped file is too big for in-memory processing FZip.Entries.AddFileEntry(FSContentTypes, OOXML_PATH_TYPES); FZip.Entries.AddFileEntry(FSRelsRels, OOXML_PATH_RELS_RELS); FZip.Entries.AddFileEntry(FSWorkbookRels, OOXML_PATH_XL_RELS_RELS); FZip.Entries.AddFileEntry(FSWorkbook, OOXML_PATH_XL_WORKBOOK); FZip.Entries.AddFileEntry(FSStyles, OOXML_PATH_XL_STYLES); if FSSharedStrings_complete.Size > 0 then FZip.Entries.AddFileEntry(FSSharedStrings_complete, OOXML_PATH_XL_STRINGS); FZip.Entries.AddFileEntry(FSMetaData, OOXML_PATH_DOCPROPS_CORE); if TsWorkbook(FWorkbook).MetaData.Custom.Count > 0 then FZip.Entries.AddFileEntry(FSCustomMetaData, OOXML_PATH_DOCPROPS_CUSTOM); // Write embedded images WriteMedia(FZip); // Write worksheets for i:=0 to High(FSSheets) do begin FSSheets[i].Position:= 0; FZip.Entries.AddFileEntry(FSSheets[i], OOXML_PATH_XL_WORKSHEETS + Format('sheet%d.xml', [i+1])); end; // Write comments for i:=0 to High(FSComments) do begin if (FSComments[i] = nil) or (FSComments[i].Size = 0) then continue; FSComments[i].Position := 0; FZip.Entries.AddFileEntry(FSComments[i], OOXML_PATH_XL + Format('comments%d.xml', [i+1])); end; // Write worksheet relationships for i:=0 to High(FSSheetRels) do begin if (FSSheetRels[i] = nil) or (FSSheetRels[i].Size = 0) then continue; FSSheetRels[i].Position := 0; FZip.Entries.AddFileEntry(FSSheetRels[i], OOXML_PATH_XL_WORKSHEETS_RELS + Format('sheet%d.xml.rels', [i+1])); end; // Write drawings for i:=0 to High(FSDrawings) do begin if (FSDrawings[i] = nil) or (FSDrawings[i].Size = 0) then continue; FSDrawings[i].Position := 0; FZip.Entries.AddFileEntry(FSDrawings[i], OOXML_PATH_XL_DRAWINGS + Format('drawing%d.xml', [i+1])); end; for i:=0 to High(FSVmlDrawings) do begin if (FSVmlDrawings[i] = nil) or (FSVmlDrawings[i].Size = 0) then continue; FSVmlDrawings[i].Position := 0; FZip.Entries.AddFileEntry(FSVmlDrawings[i], OOXML_PATH_XL_DRAWINGS + Format('vmlDrawing%d.vml', [i+1])); end; for i:=0 to High(FSDrawingsRels) do begin if (FSDrawingsRels[i] = nil) or (FSDrawingsRels[i].Size = 0) then continue; FSDrawingsRels[i].Position := 0; FZip.Entries.AddFileEntry(FSDrawingsRels[i], OOXML_PATH_XL_DRAWINGS_RELS + Format('drawing%d.xml.rels', [i+1])); end; for i:=0 to High(FSVmlDrawingsRels) do begin if (FSVmlDrawingsRels[i] = nil) or (FSVmlDrawingsRels[i].Size = 0) then continue; FSVmlDrawingsRels[i].Position := 0; FZip.Entries.AddFileEntry(FSVmlDrawingsRels[i], OOXML_PATH_XL_DRAWINGS_RELS + Format('vmlDrawing%d.vml.rels', [i+1])); end; FZip.SaveToStream(AStream); finally DestroyStreams; FZip.Free; end; end; procedure TsSpreadOOXMLWriter.WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); var cellPosText: String; lStyleIndex: Integer; begin cellPosText := TsWorksheet.CellPosToText(ARow, ACol); lStyleIndex := GetStyleIndex(ACell); AppendToStream(AStream, Format( '', [CellPosText, lStyleIndex]), '', ''); end; {@@ ---------------------------------------------------------------------------- Writes a boolean value to the stream -------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.WriteBool(AStream: TStream; const ARow, ACol: Cardinal; const AValue: Boolean; ACell: PCell); var CellPosText: String; CellValueText: String; lStyleIndex: Integer; begin CellPosText := GetCellString(ARow, ACol); lStyleIndex := GetStyleIndex(ACell); CellValueText := StrUtils.IfThen(AValue, '1', '0'); AppendToStream(AStream, Format( '%s', [CellPosText, lStyleIndex, CellValueText])); end; {@@ ---------------------------------------------------------------------------- Writes an error value to the specified cell. -------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.WriteError(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell); var CellPosText: String; CellValueText: String; lStyleIndex: Integer; begin Unused(AValue); CellPosText := TsWorksheet.CellPosToText(ARow, ACol); lStyleIndex := GetStyleIndex(ACell); CellValueText := GetErrorValueStr(ACell^.ErrorValue); AppendToStream(AStream, Format( '%s', [CellPosText, lStyleIndex, CellValueText])); end; {@@ ---------------------------------------------------------------------------- Writes a string formula to the given cell. -------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); var cellPosText: String; lStyleIndex: Integer; t, v: String; formula: PsFormula; formulaStr: String; begin cellPosText := TsWorksheet.CellPosToText(ARow, ACol); lStyleIndex := GetStyleIndex(ACell); formula := TsWorksheet(FWorksheet).Formulas.FindFormula(ARow, ACol); formulaStr := PrepareFormula(formula^.Text); case ACell^.ContentType of cctFormula: begin t := ''; v := ''; end; cctUTF8String: begin t := ' t="str"'; v := Format('%s', [UTF8TextToXMLText(ACell^.UTF8StringValue)]); end; cctNumber: begin t := ''; v := Format('%g', [ACell^.NumberValue], FPointSeparatorSettings); end; cctDateTime: begin t := ''; v := Format('%g', [ACell^.DateTimeValue], FPointSeparatorSettings); end; cctBool: begin t := ' t="b"'; if ACell^.BoolValue then v := '1' else v := '0'; end; cctError: begin t := ' t="e"'; v := Format('%s', [GetErrorValueStr(ACell^.ErrorValue)]); end; end; AppendToStream(AStream, Format( '' + '%s' + '%s' + '', [ CellPosText, lStyleIndex, t, formulaStr, v ])); end; {@@ ---------------------------------------------------------------------------- Writes a string to the stream If the string length exceeds 32767 bytes, the string will be truncated and a warning will be written to the workbook's log. -------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; const AValue: string; ACell: PCell); const MAXBYTES = 32767; // limit for this format var CellPosText: string; lStyleIndex: Cardinal; ResultingValue: string; fnt: TsFont; i, n, L: Integer; rtParam: TsRichTextParam; txt: String; begin // Office 2007-2010 (at least) supports no more characters in a cell; if Length(AValue) > MAXBYTES then begin ResultingValue := Copy(AValue, 1, MAXBYTES); //may chop off multicodepoint UTF8 characters but well... Workbook.AddErrorMsg(rsTruncateTooLongCellText, [ MAXBYTES, GetCellString(ARow, ACol) ]); end else ResultingValue := AValue; { Check for invalid characters } txt := ResultingValue; if not ValidXMLText(txt) then Workbook.AddErrorMsg( rsInvalidCharacterInCell, [ GetCellString(ARow, ACol) ]); { Write string to SharedString table } if Length(ACell^.RichTextParams) = 0 then // unformatted string AppendToStream(FSSharedStrings, '' + '' + txt + '' + '') else begin // rich-text formatted string FixLineEndings(ResultingValue, ACell^.RichTextParams); L := UTF8Length(Resultingvalue); AppendToStream(FSSharedStrings, ''); rtParam := ACell^.RichTextParams[0]; if rtParam.FirstIndex > 1 then begin // Unformatted part before first format txt := UTF8Copy(ResultingValue, 1, rtParam.FirstIndex - 1); ValidXMLText(txt); AppendToStream(FSSharedStrings, '' + '' + txt + '' + '' ); end; for i := 0 to High(ACell^.RichTextParams) do begin rtParam := ACell^.RichTextParams[i]; fnt := (FWorkbook as TsWorkbook).GetFont(rtParam.FontIndex); // Calculate count of characters in this format section if i = High(ACell^.RichTextParams) then n := L - rtParam.FirstIndex + 1 else n := ACell^.RichTextParams[i+1].FirstIndex - rtParam.FirstIndex; // Partial string having this format txt := UTF8Copy(Resultingvalue, rtParam.FirstIndex, n); ValidXMLText(txt); AppendToStream(FSSharedStrings, ''); WriteFont(FSSharedStrings, fnt, false); // ... font data ... AppendToStream(FSSharedStrings, '' + txt + '' + '' ); end; AppendToStream(FSSharedStrings, ''); end; { Write shared string index to cell record } CellPosText := TsWorksheet.CellPosToText(ARow, ACol); lStyleIndex := GetStyleIndex(ACell); AppendToStream(AStream, Format( ''+ '%d'+ '', [CellPosText, lStyleIndex, FSharedStringsCount] )); inc(FSharedStringsCount); end; {@@ ---------------------------------------------------------------------------- Writes a number (64-bit IEE 754 floating point) to the stream -------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); var CellPosText: String; CellValueText: String; lStyleIndex: Integer; begin CellPosText := TsWorksheet.CellPosToText(ARow, ACol); lStyleIndex := GetStyleIndex(ACell); CellValueText := FloatToStr(AValue, FPointSeparatorSettings); AppendToStream(AStream, Format( '%s', [CellPosText, lStyleIndex, CellValueText])); end; {@@ ---------------------------------------------------------------------------- Writes a date/time value as a number Respects DateMode of the file -------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); var ExcelDateSerial: double; begin ExcelDateSerial := ConvertDateTimeToExcelDateTime(AValue, FDateMode); WriteNumber(AStream, ARow, ACol, ExcelDateSerial, ACell); end; initialization // Registers this reader / writer on fpSpreadsheet sfidOOXML := RegisterSpreadFormat(sfOOXML, TsSpreadOOXMLReader, TsSpreadOOXMLWriter, STR_FILEFORMAT_EXCEL_XLSX, 'OOXML', [STR_OOXML_EXCEL_EXTENSION, '.xlsm'] ); end.