{------------------------------------------------------------------------------- Unit : xlsxml Implements a reader and writer for the SpreadsheetXML format. This document was introduced by Microsoft for Excel XP and 2003. REFERENCE: http://msdn.microsoft.com/en-us/library/aa140066%28v=office.15%29.aspx AUTHOR : Werner Pamler LICENSE : For details about the license, see the file COPYING.modifiedLGPL.txt included in the Lazarus distribution. -------------------------------------------------------------------------------} unit xlsxml; {$ifdef fpc} {$mode objfpc}{$H+} {$endif} interface uses Classes, SysUtils, laz2_xmlread, laz2_DOM, fpsTypes, fpsReaderWriter, fpsXMLCommon, xlsCommon; type { TsSpreadExcelXMLReader } TsSpreadExcelXMLReader = class(TsSpreadXMLReader) private FDateMode: TDateMode; FPointSeparatorSettings: TFormatSettings; function ExtractDateTime(AText: String): TDateTime; protected FFirstNumFormatIndexInFile: Integer; procedure AddBuiltinNumFormats; override; protected procedure ReadAlignment(ANode: TDOMNode; var AFormat: TsCellFormat); procedure ReadBorder(ANode: TDOMNode; var AFormat: TsCellFormat); procedure ReadBorders(ANode: TDOMNode; var AFormat: TsCellFormat); procedure ReadCell(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARow, ACol: Integer); procedure ReadCellProtection(ANode: TDOMNode; var AFormat: TsCellFormat); procedure ReadComment(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ACell: PCell); procedure ReadExcelWorkbook(ANode: TDOMNode); procedure ReadFont(ANode: TDOMNode; var AFormat: TsCellFormat); procedure ReadInterior(ANode: TDOMNode; var AFormat: TsCellFormat); procedure ReadNames(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadNumberFormat(ANode: TDOMNode; var AFormat: TsCellFormat); procedure ReadPageSetup(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadPrint(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadRow(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARow: Integer); procedure ReadStyle(ANode: TDOMNode); procedure ReadStyles(ANode: TDOMNode); procedure ReadTable(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadWorksheet(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadWorksheetOptions(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadWorksheets(ANode: TDOMNode); public constructor Create(AWorkbook: TsBasicWorkbook); override; procedure ReadFromStream(AStream: TStream; APassword: String = ''; AParams: TsStreamParams = []); override; end; { TsSpreadExcelXMLWriter } TsSpreadExcelXMLWriter = class(TsCustomSpreadWriter) private FDateMode: TDateMode; FPointSeparatorSettings: TFormatSettings; FFirstRow, FFirstCol: Cardinal; FlastRow, FLastCol: Cardinal; FPrevRow, FPrevCol: Cardinal; function GetCommentStr(ACell: PCell): String; function GetFormulaStr(ACell: PCell): String; function GetFrozenPanesStr(AWorksheet: TsBasicWorksheet; AIndent: String): String; function GetHyperlinkStr(ACell: PCell): String; function GetIndexStr(AIndex, APrevIndex: Integer): String; function GetLayoutStr(AWorksheet: TsBasicWorksheet): String; function GetMergeStr(ACell: PCell): String; function GetPageFooterStr(AWorksheet: TsBasicWorksheet): String; function GetPageHeaderStr(AWorksheet: TsBasicWorksheet): String; function GetPageMarginStr(AWorksheet: TsBasicWorksheet): String; function GetPrintStr(AWorksheet: TsBasicWorksheet): String; function GetStyleStr(AFormatIndex: Integer): String; procedure WriteCellNodes(AStream: TStream; AWorksheet: TsBasicWorksheet; ARow: Cardinal); procedure WriteColumns(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteExcelWorkbook(AStream: TStream); procedure WriteNames(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteRows(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteStyle(AStream: TStream; AIndex: Integer); procedure WriteStyles(AStream: TStream); procedure WriteTable(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteWorksheet(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteWorksheetOptions(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteWorksheets(AStream: TStream); protected 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 WriteCellToStream(AStream: TStream; 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 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; procedure WriteToStream(AStream: TStream; AParams: TsStreamParams = []); override; end; TExcelXmlSettings = record DateMode: TDateMode; end; var { Default parameters for reading/writing } ExcelXmlSettings: TExcelXmlSettings = ( DateMode: dm1900; ); sfidExcelXML: TsSpreadFormatID; implementation uses StrUtils, DateUtils, Math, Variants, fpsStrings, fpsClasses, fpspreadsheet, fpsUtils, fpsNumFormat, fpsHTMLUtils, fpsExprParser; const FMT_OFFSET = 61; INDENT1 = ' '; INDENT2 = ' '; INDENT3 = ' '; INDENT4 = ' '; INDENT5 = ' '; NAMES_INDENT = INDENT2; NAME_INDENT = INDENT3; TABLE_INDENT = INDENT2; ROW_INDENT = INDENT3; COL_INDENT = INDENT3; CELL_INDENT = INDENT4; VALUE_INDENT = INDENT5; LF = LineEnding; const {TsFillStyle = ( fsNoFill, fsSolidFill, fsGray75, fsGray50, fsGray25, fsGray12, fsGray6, fsStripeHor, fsStripeVert, fsStripeDiagUp, fsStripeDiagDown, fsThinStripeHor, fsThinStripeVert, fsThinStripeDiagUp, fsThinStripeDiagDown, fsHatchDiag, fsThinHatchDiag, fsThickHatchDiag, fsThinHatchHor) } FILL_NAMES: array[TsFillStyle] of string = ( '', 'Solid', // 'Solid', 'Solid', 'Solid', 'Solid', 'Solid', 'Gray75', 'Gray50', 'Gray25', 'Gray125', 'Gray0625', 'HorzStripe', 'VertStripe', 'DiagStripe', 'ReverseDiagStripe', 'ThinHorzStripe', 'ThinVertStripe', 'ThinDiagStripe', 'ThinReverseDiagStripe', 'DiagCross', 'ThinDiagCross', 'ThickDiagCross', 'ThinHorzCross' ); {TsCellBorder = (cbNorth, cbWest, cbEast, cbSouth, cbDiagUp, cbDiagDown); } BORDER_NAMES: array[TsCellBorder] of string = ( 'Top', 'Left', 'Right', 'Bottom', 'DiagonalRight', 'DiagonalLeft' ); {TsLineStyle = ( lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble, lsHair, lsMediumDash, lsDashDot, lsMediumDashDot, lsDashDotDot, lsMediumDashDotDot, lsSlantDashDot) } LINE_STYLES: array[TsLineStyle] of string = ( 'Continuous', 'Continuous', 'Dash', 'Dot', 'Continuous', 'Double', 'Continuous', 'Dash', 'DashDot', 'DashDot', 'DashDotDot', 'DashDotDot', 'SlantDashDot' ); LINE_WIDTHS: array[TsLineStyle] of Integer = ( 1, 2, 1, 1, 3, 3, 0, 2, 1, 2, 1, 2, 2 ); FALSE_TRUE: array[boolean] of string = ('False', 'True'); function GetCellContentTypeStr(ACell: PCell): String; begin case ACell^.ContentType of cctNumber : Result := 'Number'; cctUTF8String : Result := 'String'; cctDateTime : Result := 'DateTime'; cctBool : Result := 'Boolean'; cctError : Result := 'Error'; else raise EFPSpreadsheet.Create('Content type error in cell ' + GetCellString(ACell^.Row, ACell^.Col)); end; end; { Helper routine to rebuild the html content of the "ss:Data" nodes } procedure RebuildChildNodes(ANode: TDOMNode; var AText: String); var nodeName: String; s: String; i: Integer; begin if ANode = nil then exit; while ANode <> nil do begin nodeName := ANode.NodeName; if nodeName = '#text' then AText := AText + ANode.NodeValue else begin s := ''; for i := 0 to ANode.Attributes.Length-1 do s := Format('%s %s="%s"', [s, ANode.Attributes.Item[i].NodeName, ANode.Attributes.Item[i].NodeValue]); AText := Format('%s<%s%s>', [AText, nodeName, s]); s := ''; RebuildChildNodes(ANode.FirstChild, s); if s <> '' then AText := Format('%s%s', [AText, s, nodeName]); end; ANode := ANode.NextSibling; end; end; {=============================================================================== TsSpreadExcelXMLReader ===============================================================================} {@@ ---------------------------------------------------------------------------- Constructor of the ExcelXML reader -------------------------------------------------------------------------------} constructor TsSpreadExcelXMLReader.Create(AWorkbook: TsBasicWorkbook); begin inherited; // Cell formats (named "Styles" here). FCellFormatList := TsCellFormatList.Create(true); // is destroyed by ancestor // Special version of FormatSettings using a point decimal separator for sure. FPointSeparatorSettings := DefaultFormatSettings; FPointSeparatorSettings.DecimalSeparator := '.'; end; procedure TsSpreadExcelXMLReader.AddBuiltinNumFormats; begin FFirstNumFormatIndexInFile := 164; AddBuiltInBiffFormats( FNumFormatList, FWorkbook.FormatSettings, FFirstNumFormatIndexInFile-1 ); end; {@@ ---------------------------------------------------------------------------- Extracts the date/time value from the given string. The string is formatted as 'yyyy-mm-dd"T"hh:nn:ss.zzz' -------------------------------------------------------------------------------} function TsSpreadExcelXMLReader.ExtractDateTime(AText: String): TDateTime; var dateStr, timeStr: String; begin dateStr := Copy(AText, 1, 10); timeStr := Copy(AText, 12, MaxInt); Result := ScanDateTime('yyyy-mm-dd', dateStr) + ScanDateTime('hh:nn:ss.zzz', timeStr); end; {@@ ---------------------------------------------------------------------------- Reads the cell alignment from the given node attributes -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadAlignment(ANode: TDOMNode; var AFormat: TsCellFormat); var s: String; begin // Vertical alignment s := GetAttrValue(ANode, 'ss:Vertical'); if s <> '' then with AFormat do begin Include(UsedFormattingFields, uffVertAlign); case s of 'Top': VertAlignment := vaTop; 'Center': VertAlignment := vaCenter; 'Bottom': VertAlignment := vaBottom; else Exclude(UsedFormattingFields, uffVertAlign); end; end; // Horizontal alignment s := GetAttrValue(ANode, 'ss:Horizontal'); if s <> '' then with AFormat do begin Include(UsedFormattingFields, uffHorAlign); case s of 'Left': HorAlignment := haLeft; 'Center': HorAlignment := haCenter; 'Right': HorAlignment := haRight; else Exclude(UsedFormattingFields, uffHorAlign); end; end; // Vertical text s := GetAttrValue(ANode, 'ss:Rotate'); if s = '90' then with AFormat do begin TextRotation := rt90DegreeCounterClockwiseRotation; Include(UsedFormattingFields, uffTextRotation); end else if s = '-90' then with AFormat do begin TextRotation := rt90DegreeClockwiseRotation; Include(UsedFormattingFields, uffTextRotation); end; s := GetAttrValue(ANode, 'ss:VerticalText'); if s <> '' then with AFormat do begin TextRotation := rtStacked; Include(UsedFormattingFields, uffTextRotation); end; // Word wrap s := GetAttrValue(ANode, 'ss:WrapText'); if s = '1' then with AFormat do Include(UsedFormattingFields, uffWordWrap); // BiDi s := GetAttrValue(ANode, 'ss:ReadingOrder'); if s <> '' then with AFormat do begin case s of 'RightToLeft': BiDiMode := bdRTL; 'LeftToRight': BiDiMode := bdLTR; end; Include(UsedFormattingFields, uffBiDi); end; end; {@@ ---------------------------------------------------------------------------- Read a "Style/Borders/Border" node -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadBorder(ANode: TDOMNode; var AFormat: TsCellFormat); // var s, sw: String; b: TsCellBorder; begin AFormat.UsedFormattingFields := AFormat.UsedFormattingFields + [uffBorder]; // Border position s := GetAttrValue(ANode, 'ss:Position'); case s of 'Left': b := cbWest; 'Right': b := cbEast; 'Top': b := cbNorth; 'Bottom': b := cbSouth; 'DiagonalRight': b := cbDiagUp; 'DiagonalLeft': b := cbDiagDown; end; Include(AFormat.Border, b); // Border color s := GetAttrValue(ANode, 'ss:Color'); if s = '' then AFormat.BorderStyles[b].Color := scBlack else AFormat.BorderStyles[b].Color := HTMLColorStrToColor(s); // Line style s := GetAttrValue(ANode, 'ss:LineStyle'); sw := GetAttrValue(ANode, 'ss:Weight'); case s of 'Continuous': if sw = '1' then AFormat.BorderStyles[b].LineStyle := lsThin else if sw = '2' then AFormat.BorderStyles[b].LineStyle := lsMedium else if sw = '3' then AFormat.BorderStyles[b].LineStyle := lsThick else if sw = '' then AFormat.BorderStyles[b].LineStyle := lsHair; 'Double': AFormat.BorderStyles[b].LineStyle := lsDouble; 'Dot': AFormat.BorderStyles[b].LineStyle := lsDotted; 'Dash': if sw = '2' then AFormat.BorderStyles[b].LineStyle := lsMediumDash else AFormat.BorderStyles[b].LineStyle := lsDashed; 'DashDot': if sw = '2' then AFormat.BorderStyles[b].LineStyle := lsMediumDashDot else AFormat.BorderStyles[b].LineStyle := lsDashDot; 'DashDotDot': if sw = '2' then AFormat.BorderStyles[b].LineStyle := lsMediumDashDotDot else AFormat.BorderStyles[b].LineStyle := lsDashDotDot; 'SlantDashDot': AFormat.BorderStyles[b].LineStyle := lsSlantDashDot; end; end; {@@ ---------------------------------------------------------------------------- Reads the "Styles/Style/Borders" nodes -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadBorders(ANode: TDOMNode; var AFormat: TsCellFormat); var nodeName: String; begin if ANode = nil then exit; ANode := ANode.FirstChild; while ANode <> nil do begin nodeName := ANode.NodeName; if nodeName = 'Border' then ReadBorder(ANode, AFormat); ANode := ANode.NextSibling; end; end; {@@ ---------------------------------------------------------------------------- Reads a "Worksheet/Table/Row/Cell" node -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadCell(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARow, ACol: Integer); var book: TsWorkbook; sheet: TsWorksheet absolute AWorksheet; nodeName: string; s, st, sv: String; txt: String; node: TDOMNode; err: TsErrorValue; cell: PCell; fmt: TsCellFormat; nfp: TsNumFormatParams; idx: Integer; mergedCols, mergedRows: Integer; font: TsFont; dt: TDateTime; begin if ANode = nil then exit; nodeName := ANode.NodeName; if nodeName <> 'Cell' then raise Exception.Create('[ReadCell] "Cell" node expected.'); book := TsWorkbook(FWorkbook); font := book.GetDefaultFont; if FIsVirtualMode then begin if not Assigned(book.OnReadCellData) then exit; InitCell(FWorksheet, ARow, ACol, FVirtualCell); cell := @FVirtualCell; end else cell := sheet.AddCell(ARow, ACol); s := GetAttrValue(ANode, 'ss:StyleID'); if s <> '' then begin idx := FCellFormatList.FindIndexOfName(s); if idx <> -1 then begin fmt := FCellFormatList.Items[idx]^; cell^.FormatIndex := book.AddCellFormat(fmt); font := book.GetFont(fmt.FontIndex); end; end else begin InitFormatRecord(fmt); cell^.FormatIndex := 0; end; // Merged cells s := GetAttrValue(ANode, 'ss:MergeAcross'); if not ((s <> '') and TryStrToInt(s, mergedCols)) then mergedCols := 0; s := GetAttrValue(ANode, 'ss:MergeDown'); if not ((s <> '') and TryStrToint(s, mergedRows)) then mergedRows := 0; if (mergedCols > 0) or (mergedRows > 0) then sheet.MergeCells(ARow, ACol, ARow + mergedRows, ACol + mergedCols); // Formula s := GetAttrValue(ANode, 'ss:Formula'); if s <> '' then begin try sheet.WriteFormula(cell, s, false, true); except on E:EExprParser do begin FWorkbook.AddErrorMsg(E.Message); if (boAbortReadOnFormulaError in FWorkbook.Options) then raise; end; on E:ECalcEngine do begin FWorkbook.AddErrorMsg(E.Message); if (boAbortReadOnFormulaError in FWorkbook.Options) then raise; end; end; end; // Hyperlink s := GetAttrValue(ANode, 'ss:HRef'); if s <> '' then begin st := GetAttrValue(ANode, 'x:HRefScreenTip'); sheet.WriteHyperlink(cell, s, st); end; // Cell data and comment node := ANode.FirstChild; if node = nil then sheet.WriteBlank(cell) else begin book.LockFormulas; // Protect formulas from being deleted by the WriteXXXX calls try while node <> nil do begin nodeName := node.NodeName; if (nodeName = 'Data') or (nodeName = 'ss:Data') then begin sv := node.TextContent; st := GetAttrValue(node, 'ss:Type'); case st of 'String': sheet.WriteText(cell, sv); 'Number': sheet.WriteNumber(cell, StrToFloat(sv, FPointSeparatorSettings)); 'DateTime': begin dt := ExtractDateTime(sv); if (cell^.FormatIndex > 0) then begin nfp := TsWorkbook(FWorkbook).GetNumberFormat(fmt.NumberFormatIndex); if not IsTimeIntervalFormat(nfp) then dt := ConvertExcelDateTimeToDateTime(dt, FDateMode); end; sheet.WriteDateTime(cell, dt); end; 'Boolean': if sv = '1' then sheet.WriteBoolValue(cell, true) else if sv = '0' then sheet.WriteBoolValue(cell, false); 'Error': if TryStrToErrorValue(sv, err) then sheet.WriteErrorValue(cell, err); end; if nodeName = 'ss:Data' then begin txt := ''; RebuildChildNodes(node, txt); HTMLToRichText(FWorkbook, font, txt, s, cell^.RichTextParams, 'html:'); end; end else if (nodeName = 'Comment') then ReadComment(node, AWorksheet, cell); node := node.NextSibling; end; if FIsVirtualMode then book.OnReadCellData(book, ARow, ACol, cell); finally book.UnlockFormulas; end; end; end; {@@ ---------------------------------------------------------------------------- Reads the "Styles/Style/Protection" node -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadCellProtection(ANode: TDOMNode; var AFormat: TsCellFormat); var s: String; begin if ANode = nil then exit; s := GetAttrValue(ANode, 'ss:Protected'); if s = '0' then Exclude(AFormat.Protection, cpLockCell); s := GetAttrValue(ANode, 'x:HideFormula'); if s = '1' then Include(AFormat.Protection, cpHideFormulas); if AFormat.Protection <> DEFAULT_CELL_PROTECTION then Include(AFormat.UsedFormattingFields, uffProtection); end; {@@ ---------------------------------------------------------------------------- Reads the "Worksheet/Table/Row/Cell/Comment" node -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadComment(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ACell: PCell); var txt: String; begin txt := ANode.TextContent; TsWorksheet(AWorksheet).WriteComment(ACell, txt); end; {@@ ---------------------------------------------------------------------------- Reads the "ExcelWorkbook" node -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadExcelWorkbook(ANode: TDOMNode); var s: String; nodeName: String; n: Integer; begin if ANode = nil then exit; ANode := ANode.FirstChild; while ANode <> nil do begin nodeName := ANode.NodeName; if nodeName = 'ActiveSheet' then begin s := ANode.TextContent; if (s <> '') and TryStrToInt(s, n) then with TsWorkbook(FWorkbook) do SelectWorksheet(GetWorksheetByIndex(n)); end else if nodeName = 'ProtectStructure' then begin s := ANode.TextContent; if s = 'True' then FWorkbook.Protection := FWorkbook.Protection + [bpLockStructure]; end else if nodeName = 'ProtectWindows' then begin s := ANode.TextContent; if s = 'True' then FWorkbook.Protection := FWorkbook.Protection + [bpLockWindows]; end else if nodeName = 'Date1904' then FDateMode := dm1904; ANode := ANode.NextSibling; end; end; {@@ ---------------------------------------------------------------------------- Reads the "Styles/Style/Font" node -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLreader.ReadFont(ANode: TDOMNode; var AFormat: TsCellFormat); var book: TsWorkbook; fname: String; fsize: Single; fcolor: TsColor; fstyle: TsFontStyles; s: String; begin if ANode = nil then exit; book := TsWorkbook(FWorkbook); fname := GetAttrValue(ANode, 'ss:FontName'); if fname = '' then fname := book.GetDefaultFont.FontName; s := GetAttrValue(ANode, 'ss:Size'); if (s = '') or not TryStrToFloat(s, fsize, FPointSeparatorSettings) then fsize := book.GetDefaultFont.Size; s := GetAttrValue(ANode, 'ss:Color'); if s <> '' then fcolor := HTMLColorStrToColor(s) else fcolor := book.GetDefaultFont.Color; fstyle := []; s := GetAttrValue(ANode, 'ss:Bold'); if s = '1' then Include(fstyle, fssBold); s := GetAttrValue(ANode, 'ss:Italic'); if s = '1' then Include(fstyle, fssItalic); s := GetAttrValue(ANode, 'ss:Underline'); if s <> '' then Include(fstyle, fssUnderline); s := GetAttrValue(ANode, 'ss:StrikeThrough'); if s = '1' then Include(fstyle, fssStrikeout); AFormat.FontIndex := book.AddFont(fname, fsize, fstyle, fcolor); Include(AFormat.UsedFormattingFields, uffFont); end; {@@ ---------------------------------------------------------------------------- Reads the "Styles/Style/Interior" node -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadInterior(ANode: TDOMNode; var AFormat: TsCellFormat); var s, sfg, sbg: String; fs: TsFillStyle; begin if ANode = nil then exit; // Pattern s := GetAttrValue(ANode, 'ss:Pattern'); if s = '' then exit; for fs in TsFillStyle do if FILL_NAMES[fs] = s then begin AFormat.Background.Style := fs; break; end; // Foreground color (pattern color) sfg := GetAttrValue(ANode, 'ss:PatternColor'); if sfg = '' then AFormat.Background.FgColor := scBlack else AFormat.Background.FgColor := HTMLColorStrToColor(sfg); // Background color sbg := GetAttrValue(ANode, 'ss:Color'); if sbg = '' then AFormat.Background.BgColor := scWhite else AFormat.Background.BgColor := HTMLColorStrToColor(sbg); // Fix solid fill colors: make foreground and background color the same if AFormat.Background.Style = fsSolidFill then begin if (sfg <> '') then AFormat.Background.BgColor := AFormat.Background.FgColor // Forground priority else if (sfg = '') and (sbg <> '') then AFormat.Background.FgColor := AFormat.Background.BgColor; end; Include(AFormat.UsedFormattingFields, uffBackground); end; {@@ ---------------------------------------------------------------------------- Reads a "Worksheet/Names" node -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadNames(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure DoProcess(AStr: String; var ARowIndex, AColIndex: Cardinal; out IsRow: Boolean); var p: Integer; begin p := pos('!', AStr); if p > 0 then AStr := Copy(AStr, p+1, MaxInt); IsRow := AStr[1] in ['R', 'r']; Delete(AStr, 1, 1); if IsRow then ARowIndex := StrToInt(AStr) - 1 else AColIndex := StrToInt(AStr) - 1; end; procedure DoRepeatedRowsCols(AStr: String); var p: Integer; isRow: Boolean; r1: Cardinal = UNASSIGNED_ROW_COL_INDEX; c1: Cardinal = UNASSIGNED_ROW_COL_INDEX; r2: Cardinal = UNASSIGNED_ROW_COL_INDEX; c2: Cardinal = UNASSIGNED_ROW_COL_INDEX; begin p := pos(':', AStr); // No colon --> Single range, e.g. "=Sheet1!C1" if p = 0 then begin DoProcess(AStr, r1, c1, isRow); r2 := r1; c2 := c1; end else // Colon --> Range block, e.g. "Sheet1!R1:R2" begin DoProcess(copy(AStr, 1, p-1), r1, c1, isRow); DoProcess(copy(AStr, p+1, MaxInt), r2, c2, isRow); end; if isRow then TsWorksheet(AWorksheet).PageLayout.SetRepeatedRows(r1, r2) else TsWorksheet(AWorksheet).PageLayout.SetRepeatedCols(c1, c2); end; var sheet: TsWorksheet absolute AWorksheet; s, sr: String; nodeName: String; sheet1, sheet2: String; r1, c1, r2, c2: Cardinal; flags: TsRelFlags; p: Integer; ok: Boolean; begin ok := true; while ANode <> nil do begin nodeName := ANode.NodeName; if nodeName = 'NamedRange' then begin s := GetAttrValue(ANode, 'ss:Name'); if s = 'Print_Area' then begin // s := GetAttrValue(ANode, 'ss:RefersTo'); if (s <> '') then begin p := pos(',', s); while p > 0 do begin sr := Copy(s, 1, p-1); if ParseCellRangeString_R1C1(sr, 0, 0, sheet1, sheet2, r1, c1, r2, c2, flags) then sheet.PageLayout.AddPrintRange(r1, c1, r2, c2) else begin FWorkbook.AddErrorMsg('Invalid print range.'); ok := false; break; end; s := copy(s, p+1, MaxInt); p := pos(',', s); end; if ok then begin if ParseCellRangeString_R1C1(s, 0, 0, sheet1, sheet2, r1, c1, r2, c2, flags) then sheet.PageLayout.AddPrintRange(r1, c1, r2, c2) else FWorkbook.AddErrorMsg('Invalid print range.'); end; end; end else if s = 'Print_Titles' then begin // s := GetAttrValue(ANode, 'ss:RefersTo'); if s <> '' then begin p := pos(',', s); if p > 0 then begin DoRepeatedRowsCols(copy(s, 1, p-1)); DoRepeatedRowsCols(copy(s, p+1, MaxInt)); end else DoRepeatedRowsCols(s); end; end; end; ANode := ANode.NextSibling; end; end; {@@ ---------------------------------------------------------------------------- Reads a "Styles/Style/NumberFormat" node -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadNumberFormat(ANode: TDOMNode; var AFormat: TsCellFormat); var s: String; nf: TsNumberFormat = nfGeneral; nfs: String; begin if ANode = nil then exit; s := GetAttrValue(ANode, 'ss:Format'); case s of 'General': Exit; 'Standard': begin nf := nfFixedTh; nfs := BuildNumberFormatString(nf, FWorkbook.FormatSettings, 2); end; 'Fixed': begin nf := nfFixed; nfs := BuildNumberFormatString(nf, FWorkbook.FormatSettings, 2); end; 'Percent': begin nf := nfPercentage; nfs := BuildNumberFormatString(nf, FWorkbook.FormatSettings, 2); end; 'Scientific': begin nf := nfExp; nfs := BuildNumberFormatString(nf, FWorkbook.FormatSettings); end; 'Short Date': begin nf := nfShortDate; nfs := BuildDateTimeFormatString(nf, FWorkbook.FormatSettings); end; 'Short Time': begin nf := nfShortTime; nfs := BuildDateTimeFormatString(nf, FWorkbook.FormatSettings); end; else nfs := s; end; if nfs = '' then exit; AFormat.NumberFormatIndex := TsWorkbook(FWorkbook).AddNumberFormat(nfs); AFormat.NumberFormatStr := nfs; AFormat.NumberFormat := nf; Include(AFormat.UsedFormattingFields, uffNumberFormat); end; {@@ ---------------------------------------------------------------------------- Reads the "WorksheetOptions/PageSetup" node -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadPageSetup(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var sheet: TsWorksheet absolute AWorksheet; nodeName: String; s: String; n: Integer; x: Double; begin while ANode <> nil do begin nodeName := ANode.NodeName; if nodeName = 'Layout' then begin s := GetAttrValue(ANode, 'x:Orientation'); if s = 'Landscape' then sheet.PageLayout.Orientation := spoLandscape; s := GetAttrValue(ANode, 'x:CenterHorizontal'); if s = '1' then sheet.PageLayout.Options := sheet.PageLayout.Options + [poHorCentered]; s := GetAttrValue(ANode, 'x:CenterVertical'); if s = '1' then sheet.PageLayout.Options := sheet.PageLayout.Options + [poVertCentered]; s := GetAttrValue(ANode, 'x:StartPageNumber'); if (s <> '') and TryStrToInt(s, n) then sheet.PageLayout.StartPageNumber := n; end else if nodeName = 'Header' then begin s := GetAttrValue(ANode, 'x:Margin'); if (s <> '') and TryStrToFloat(s, x, FPointSeparatorSettings) then sheet.PageLayout.HeaderMargin := InToMM(x); s := GetAttrValue(ANode, 'x:Data'); sheet.PageLayout.Headers[0] := s; sheet.PageLayout.Headers[1] := s; sheet.PageLayout.Headers[2] := s; end else if nodeName = 'Footer' then begin s := GetAttrValue(ANode, 'x:Margin'); if (s <> '') and TryStrToFloat(s, x, FPointSeparatorSettings) then sheet.PageLayout.FooterMargin := InToMM(x); s := GetAttrValue(ANode, 'x:Data'); sheet.PageLayout.Footers[0] := s; sheet.PageLayout.Footers[1] := s; sheet.PageLayout.Footers[2] := s; end else if nodeName = 'PageMargins' then begin s := GetAttrValue(ANode, 'x:Bottom'); if (s <> '') and TryStrToFloat(s, x, FPointSeparatorSettings) then sheet.PageLayout.BottomMargin := InToMM(x); s := GetAttrValue(ANode, 'x:Top'); if (s <> '') and TryStrToFloat(s, x, FPointSeparatorSettings) then sheet.PageLayout.TopMargin := InToMM(x); s := GetAttrValue(ANode, 'x:Left'); if (s <> '') and TryStrToFloat(s, x, FPointSeparatorSettings) then sheet.PageLayout.LeftMargin := InToMM(x); s := GetAttrValue(ANode, 'x:Right'); if (s <> '') and TryStrToFloat(s, x, FPointSeparatorSettings) then sheet.PageLayout.RightMargin := InToMM(x); end; ANode := ANode.NextSibling; end; end; {@@ ---------------------------------------------------------------------------- Reads the "WorksheetOptions/Print" node -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadPrint(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var sheet: TsWorksheet absolute AWorksheet; nodeName: String; s: String; n: Integer; x: Double; begin while ANode <> nil do begin nodeName := ANode.NodeName; if nodeName = 'PaperSizeIndex' then begin s := ANode.TextContent; if (s <> '') and TryStrToInt(s, n) and (n < Length(PAPER_SIZES)) then begin sheet.PageLayout.PageWidth := PAPER_SIZES[n, 0]; sheet.PageLayout.pageHeight := PAPER_SIZES[n, 1]; end; end else if nodeName = 'FitHeight' then begin s := ANode.TextContent; if (s <> '') and TryStrToInt(s, n) then sheet.PageLayout.FitHeightToPages := n; end else if nodeName = 'FitWidth' then begin s := ANode.TextContent; if (s <> '') and TryStrToInt(s, n) then sheet.PageLayout.FitWidthToPages := n; end else if nodeName = 'Scale' then begin s := ANode.TextContent; if (s <> '') and TryStrToInt(s, n) then sheet.PageLayout.ScalingFactor := n; end else if nodeName = 'Gridlines' then sheet.PageLayout.Options := sheet.PageLayout.Options + [poPrintGridLines] else if nodeName = 'BlackAndWhite' then sheet.PageLayout.Options := sheet.PageLayout.Options + [poMonochrome] else if nodeName = 'DraftQuality' then sheet.PageLayout.Options := sheet.PageLayout.Options + [poDraftQuality] else if nodeName = 'LeftToRight' then sheet.PageLayout.Options := sheet.PageLayout.Options + [poPrintPagesByRows] else if nodeName = 'RowColHeadings' then sheet.PageLayout.Options := sheet.PageLayout.Options + [poPrintHeaders] else if nodeName = 'CommentsLayout' then begin s := ANode.TextContent; if s = 'SheetEnd' then sheet.PageLayout.Options := sheet.PageLayout.Options + [poCommentsAtEnd] else if s = 'InPlace' then sheet.PageLayout.Options := sheet.PageLayout.Options + [poPrintCellComments]; end; ANode := ANode.NextSibling; end; end; {@@ ---------------------------------------------------------------------------- Reads a "Worksheet/Table/Row" node -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadRow(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARow: Integer); var nodeName: String; s: String; c: Integer; begin c := 0; while ANode <> nil do begin nodeName := ANode.NodeName; if nodeName = 'Cell' then begin s := GetAttrValue(ANode, 'ss:Index'); if s <> '' then c := StrToInt(s) - 1; ReadCell(ANode, AWorksheet, ARow, c); inc(c); end; ANode := ANode.NextSibling; end; end; {@@ ---------------------------------------------------------------------------- Reads a "Styles/Style" node -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadStyle(ANode: TDOMNode); var nodeName: String; fmt: TsCellFormat; s: String; idx: Integer; childNode: TDOMNode; begin // Respect ancestor of current style s := GetAttrValue(ANode, 'ss:Parent'); if s <> '' then begin idx := FCellFormatList.FindIndexOfName(s); if idx > -1 then fmt := FCellFormatList.Items[idx]^; end else InitFormatRecord(fmt); // ID of current style. We store it in the "Name" field of the TsCellFormat // because it is a string while ID is an Integer (mostly "s", but also // "Default"). fmt.Name := GetAttrValue(ANode, 'ss:ID'); if fmt.Name = 's125' then idx := 0; // Style elements childNode := ANode.FirstChild; while childNode <> nil do begin nodeName := childNode.NodeName; if nodeName = 'Alignment' then ReadAlignment(childNode, fmt) else if nodeName = 'Borders' then ReadBorders(childNode, fmt) else if nodeName = 'Interior' then ReadInterior(childNode, fmt) else if nodeName = 'Font' then ReadFont(childNode, fmt) else if nodeName = 'NumberFormat' then ReadNumberFormat(childnode, fmt) else if nodeName = 'Protection' then ReadCellProtection(childNode, fmt); childNode := childNode.NextSibling; end; FCellFormatList.Add(fmt); end; {@@ ---------------------------------------------------------------------------- Reads the "Styles" node -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadStyles(ANode: TDOMNode); var nodeName: String; styleNode: TDOMNode; begin if ANode = nil then exit; styleNode := ANode.FirstChild; while styleNode <> nil do begin nodeName := styleNode.NodeName; if nodeName = 'Style' then ReadStyle(styleNode); styleNode := styleNode.NextSibling; end; end; {@@ ---------------------------------------------------------------------------- Reads the "Worksheet/Table" node -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadTable(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var sheet: TsWorksheet absolute AWorksheet; nodeName: String; s: String; r, c: Integer; x: Double; idx: Integer; fmt: TsCellFormat; rht: TsRowHeightType; begin r := 0; c := 0; while ANode <> nil do begin nodeName := ANode.NodeName; if nodeName = 'Column' then begin // Column index s := GetAttrValue(ANode, 'ss:Index'); if (s <> '') and TryStrToInt(s, c) then dec(c); // Column width, in Points s := GetAttrValue(ANode, 'ss:Width'); if (s <> '') and TryStrToFloat(s, x, FPointSeparatorSettings) then sheet.WriteColWidth(c, x, suPoints); // Column format s := GetAttrValue(ANode, 'ss:StyleID'); if s <> '' then begin idx := FCellFormatList.FindIndexOfName(s); if idx <> -1 then begin fmt := FCellFormatList.Items[idx]^; idx := TsWorkbook(FWorkbook).AddCellFormat(fmt); sheet.WriteColFormatIndex(c, idx); end; end; // Hidden s := GetAttrValue(ANode, 'ss:Hidden'); if s = '1' then sheet.HideCol(c); inc(c); end else if nodeName = 'Row' then begin // Default column width s := GetAttrValue(ANode, 'ss:DefaultColumnWidth'); if (s <> '') and TryStrToFloat(s, x, FPointSeparatorSettings) then sheet.WriteDefaultColWidth(x, suPoints); // Default row height s := GetAttrValue(ANode, 'ss:DefaultRowHeight'); if (s <> '') and TryStrToFloat(s, x, FPointSeparatorSettings) then sheet.WriteDefaultRowHeight(x, suPoints); // Index s := GetAttrValue(ANode, 'ss:Index'); if s <> '' then r := StrToInt(s) - 1; // AutoFitHeight s := GetAttrValue(ANode, 'ss:AutoFitHeight'); if s = '1' then rht := rhtAuto else rht := rhtCustom; // Height s := GetAttrValue(ANode, 'ss:Height'); if (s <> '') and TryStrToFloat(s, x, FPointSeparatorSettings) then sheet.WriteRowHeight(r, x, suPoints, rht); // Hidden s := GetAttrValue(ANode, 'ss:Hidden'); if (s = '1') then sheet.HideRow(r); // Row format s := GetAttrValue(ANode, 'ss:StyleID'); if s <> '' then begin idx := FCellFormatList.FindIndexOfName(s); if idx <> -1 then begin fmt := FCellFormatList.Items[idx]^; idx := TsWorkbook(FWorkbook).AddCellFormat(fmt); sheet.WriteRowFormatIndex(r, idx); end; end; // Cells in row ReadRow(ANode.FirstChild, AWorksheet, r); inc(r); end; ANode := ANode.NextSibling; end; end; {@@ ---------------------------------------------------------------------------- Reads the "Worksheet" node -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadWorksheet(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var nodeName: String; s: String; begin if ANode = nil then exit; s := GetAttrValue(ANode, 'ss:Protected'); if s ='1' then AWorksheet.Options := AWorksheet.Options + [soProtected]; ANode := ANode.FirstChild; while ANode <> nil do begin nodeName := ANode.NodeName; if nodeName = 'Table' then ReadTable(ANode.FirstChild, AWorksheet) else if nodeName = 'WorksheetOptions' then ReadWorksheetOptions(ANode.FirstChild, AWorksheet) else if nodeName = 'Names' then ReadNames(ANode.FirstChild, AWorksheet); ANode := ANode.NextSibling; end; end; {@@ ---------------------------------------------------------------------------- Reads the "Worksheet/WorksheetOptions" nodes -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadWorksheetOptions(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); var sheet: TsWorksheet absolute AWorksheet; node, childnode: TDOMNode; nodeName: String; s: String; x: Double; n: Integer; hasFitToPage: Boolean = false; c, r: Cardinal; begin if ANode = nil then exit; while ANode <> nil do begin nodeName := ANode.NodeName; if nodeName = 'PageSetup' then ReadPageSetup(ANode.FirstChild, AWorksheet) else if nodeName = 'FitToPage' then begin hasFitToPage := true; sheet.PageLayout.Options := sheet.PageLayout.Options + [poFitPages]; end else if nodeName = 'Print' then begin node := ANode.FirstChild; ReadPrint(ANode.FirstChild, AWorksheet); end else if nodeName = 'Selected' then TsWorkbook(FWorkbook).ActiveWorksheet := sheet else if nodeName = 'Panes' then begin c := sheet.ActiveCellCol; r := sheet.ActiveCellRow; node := ANode.FirstChild; while node <> nil do begin nodeName := node.NodeName; if nodeName = 'Pane' then begin childnode := node.FirstChild; while childnode <> nil do begin nodeName := childNode.NodeName; if nodeName = 'ActiveRow' then begin s := childNode.TextContent; if (s <> '') and TryStrToInt(s, n) then r := n; end else if nodeName = 'ActiveCol' then begin s := childNode.TextContent; if (s <> '') and TryStrToInt(s, n) then c := n; end; childnode := childNode.NextSibling; end; end; node := node.NextSibling; end; sheet.SelectCell(r, c); end else if nodeName = 'FreezePanes' then sheet.Options := sheet.Options + [soHasFrozenPanes] else if (nodeName = 'TopRowBottomPane') then begin s := ANode.TextContent; if (s <> '') and TryStrToInt(s, n) then sheet.TopPaneHeight := n; end else if (nodeName = 'LeftColumnRightPane') then begin s := ANode.TextContent; if (s <> '') and TryStrToInt(s, n) then sheet.LeftPaneWidth := n; end else if nodeName = 'DoNotDisplayGridlines' then sheet.Options := sheet.Options - [soShowGridLines] else if nodeName = 'DoNotDisplayHeadings' then sheet.Options := sheet.Options - [soShowHeaders] else if nodeName = 'Zoom' then begin s := ANode.TextContent; if (s <> '') and TryStrToFloat(s, x) then sheet.Zoomfactor := x * 0.01; end else if nodeName = 'Visible' then begin s := ANode.TextContent; if s = 'SheetHidden' then sheet.Options := sheet.Options + [soHidden]; end else if nodeName = 'AllowFormatCells' then sheet.Protection := sheet.Protection - [spFormatCells] else if nodeName = 'AllowSizeCols' then sheet.Protection := sheet.Protection - [spFormatColumns] else if nodeName = 'AllowSizeRows' then sheet.Protection := sheet.Protection - [spFormatRows] else if nodeName = 'AllowInsertCols' then sheet.Protection := sheet.Protection - [spInsertColumns] else if nodeName = 'AllowInsertRows' then sheet.Protection := sheet.Protection - [spInsertRows] else if nodeName = 'AllowInsertHyperlinks' then sheet.Protection := sheet.Protection - [spInsertHyperLinks] else if nodeName = 'AllowDeleteCols' then sheet.Protection := sheet.Protection - [spDeleteColumns] else if nodeName = 'AllowDeleteRows' then sheet.Protection := sheet.Protection - [spDeleteRows] else if nodeName = 'AllowSort' then sheet.Protection := sheet.Protection - [spSort] else if nodeName = 'ProtectObjects' then sheet.Protection := sheet.Protection + [spObjects] else { if nodeName = 'ProtectScenarios' then sheet.Protection := sheet.Protection + [spScenarios]; else } if nodeName = 'EnableSelection' then begin s := ANode.TextContent; if s = 'NoSelection' then sheet.Protection := sheet.Protection + [spSelectLockedCells, spSelectUnlockedCells] else if s = 'Unlocked' then sheet.Protection := sheet.Protection + [spSelectLockedCells]; end; ANode := ANode.NextSibling; end; // The ScalingFactor is always written to the xml file. This makes TsPageLayout // automatically remove the poFitPages option which is restored here. if hasFitToPage and (sheet.PageLayout.ScalingFactor <> 100) then begin sheet.PageLayout.ScalingFactor := 100; sheet.Pagelayout.Options := sheet.PageLayout.Options + [poFitPages]; end; end; (* function TsSpreadExcelXMLWriter.GetLayoutStr(AWorksheet: TsBasicWorksheet): String; var sheet: TsWorksheet absolute AWorksheet; begin Result := ''; if sheet.PageLayout.Orientation = spoLandscape then Result := Result + ' x:Orientation="Landscape"'; if (poHorCentered in sheet.PageLayout.Options) then Result := Result + ' x:CenterHorizontal="1"'; if (poVertCentered in sheet.PageLayout.Options) then Result := Result + ' x:CenterVertical="1"'; if (poUseStartPageNumber in sheet.PageLayout.Options) then Result := Result + ' x:StartPageNumber="' + IntToStr(sheet.PageLayout.StartPageNumber) + '"'; Result := ''; end; *) {@@ ---------------------------------------------------------------------------- Reads the "Worksheet" nodes -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadWorksheets(ANode: TDOMNode); var node: TDOMNode; nodeName: String; s: String; begin node := ANode; // first iterate through all worksheets, get the name and add them to the // workbook. This is because 3D formulas may refer to sheets not yet loaded. while node <> nil do begin nodeName := node.NodeName; if nodeName = 'Worksheet' then begin s := GetAttrValue(node, 'ss:Name'); if s <> '' then // the case of '' should not happen... FWorksheet := TsWorkbook(FWorkbook).AddWorksheet(s); end; node := node.NextSibling; end; // Now iterate through the worksheets again and read their contents while ANode <> nil do begin nodeName := ANode.NodeName; if nodeName = 'Worksheet' then begin s := GetAttrValue(ANode, 'ss:Name'); FWorksheet := TsWorkbook(FWorkbook).GetWorksheetByName(s); ReadWorksheet(ANode, FWorksheet); end; ANode := ANode.NextSibling; end; end; {@@ ---------------------------------------------------------------------------- Reads the workbook from the specified stream -------------------------------------------------------------------------------} procedure TsSpreadExcelXMLReader.ReadFromStream(AStream: TStream; APassword: String = ''; AParams: TsStreamParams = []); var doc: TXMLDocument; begin try ReadXMLStream(doc, AStream); // Read style list ReadStyles(doc.DocumentElement.FindNode('Styles')); // Read worksheets and their contents ReadWorksheets(doc.DocumentElement.FindNode('Worksheet')); // Read ExcelWorkbook node after worksheet nodes although before it is // found before the worksheet nodes in the file, because is requires // worksheets to be existing. ReadExcelWorkbook(doc.DocumentElement.FindNode('ExcelWorkbook')); finally doc.Free; end; end; {=============================================================================== TsSpreadExcelXMLWriter ===============================================================================} {@@ ---------------------------------------------------------------------------- Constructor of the ExcelXML writer Defines the date mode and the limitations of the file format. Initializes the format settings to be used when writing to xml. -------------------------------------------------------------------------------} constructor TsSpreadExcelXMLWriter.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 := ExcelXMLSettings.DateMode; // Special version of FormatSettings using a point decimal separator for sure. FPointSeparatorSettings := DefaultFormatSettings; FPointSeparatorSettings.DecimalSeparator := '.'; // http://en.wikipedia.org/wiki/List_of_spreadsheet_software#Specifications FLimitations.MaxColCount := 256; FLimitations.MaxRowCount := 65536; end; function TsSpreadExcelXMLWriter.GetCommentStr(ACell: PCell): String; var comment: PsComment; begin Result := ''; comment := (FWorksheet as TsWorksheet).FindComment(ACell); if Assigned(comment) then Result := INDENT1 + '' + UTF8TextToXMLText(comment^.Text) + '' + LF + CELL_INDENT; // If there will be some rich-text-like formatting in the future, use // Result := ''+comment^.Text+'': end; function TsSpreadExcelXMLWriter.GetFormulaStr(ACell: PCell): String; begin if HasFormula(ACell) then begin Result := UTF8TextToXMLText((FWorksheet as TsWorksheet).ConvertFormulaDialect(ACell, fdExcelR1C1)); Result := ' ss:Formula="=' + Result + '"'; end else Result := ''; end; function TsSpreadExcelXMLWriter.GetFrozenPanesStr(AWorksheet: TsBasicWorksheet; AIndent: String): String; var activePane: Integer; sheet: TsWorksheet absolute AWorksheet; begin if (soHasFrozenPanes in sheet.Options) then begin Result := AIndent + '' + LF + AIndent + '' + LF; if sheet.LeftPaneWidth > 0 then Result := Result + AIndent + '1' + LF + AIndent + '' + IntToStr(sheet.LeftPaneWidth) + '' + LF; if sheet.TopPaneHeight > 0 then Result := Result + AIndent + '1' + LF + AIndent + '' + IntToStr(sheet.TopPaneHeight) + '' + LF; if (sheet.LeftPaneWidth = 0) and (sheet.TopPaneHeight = 0) then activePane := 3 else if (sheet.LeftPaneWidth = 0) then activePane := 2 else if (sheet.TopPaneHeight = 0) then activePane := 1 else activePane := 0; Result := Result + AIndent + '' + IntToStr(activePane) + '' + LF; end else Result := ''; end; function TsSpreadExcelXMLWriter.GetHyperlinkStr(ACell: PCell): String; var hyperlink: PsHyperlink; begin hyperlink := (FWorksheet as TsWorksheet).FindHyperlink(ACell); if Assigned(hyperlink) then begin Result := ' ss:HRef="' + hyperlink^.Target + '"'; if hyperlink^.ToolTip <> '' then Result := Result + ' x:HRefScreenTip="' + UTF8TextToXMLText(hyperlink^.ToolTip) + '"'; end else Result := ''; end; function TsSpreadExcelXMLWriter.GetIndexStr(AIndex, APrevIndex: Integer): String; begin if (APrevIndex = -1) and (AIndex = 0) then Result := '' else if (APrevIndex >= 0) and (AIndex = APrevIndex + 1) then Result := '' else Result := Format(' ss:Index="%d"', [AIndex + 1]); end; function TsSpreadExcelXMLWriter.GetLayoutStr(AWorksheet: TsBasicWorksheet): String; var sheet: TsWorksheet absolute AWorksheet; begin Result := ''; if sheet.PageLayout.Orientation = spoLandscape then Result := Result + ' x:Orientation="Landscape"'; if (poHorCentered in sheet.PageLayout.Options) then Result := Result + ' x:CenterHorizontal="1"'; if (poVertCentered in sheet.PageLayout.Options) then Result := Result + ' x:CenterVertical="1"'; if (poUseStartPageNumber in sheet.PageLayout.Options) then Result := Result + ' x:StartPageNumber="' + IntToStr(sheet.PageLayout.StartPageNumber) + '"'; Result := ''; end; function TsSpreadExcelXMLWriter.GetMergeStr(ACell: PCell): String; var r1, c1, r2, c2: Cardinal; begin Result := ''; if (FWorksheet as TsWorksheet).IsMerged(ACell) then begin (FWorksheet as TsWorksheet).FindMergedRange(ACell, r1, c1, r2, c2); if c2 > c1 then Result := Result + Format(' ss:MergeAcross="%d"', [c2-c1]); if r2 > r1 then Result := Result + Format(' ss:MergeDown="%d"', [r2-r1]); end; end; function TsSpreadExcelXMLWriter.GetPageFooterStr( AWorksheet: TsBasicWorksheet): String; var sheet: TsWorksheet absolute AWorksheet; begin Result := Format('x:Margin="%g"', [mmToIn(sheet.PageLayout.FooterMargin)], FPointSeparatorSettings); if (sheet.PageLayout.Footers[HEADER_FOOTER_INDEX_ALL] <> '') then Result := Result + ' x:Data="' + UTF8TextToXMLText(sheet.PageLayout.Footers[HEADER_FOOTER_INDEX_ALL], true) + '"'; Result := '