fpspreadsheet: Add writer for ExcelXML files (Office XP and 2003, will be needed for clipboard operations); formulas and rich-text not functional, yet.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4338 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2015-09-19 22:55:18 +00:00
parent b1902b12c6
commit 0dc5a6e45e
7 changed files with 602 additions and 24 deletions
--- a/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm
+++ b/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm
@ -342,7 +342,7 @@ object MainForm: TMainForm
      CellFormatItem = cfiFontName
      WorkbookSource = WorkbookSource
      DropDownCount = 24
-      ItemIndex = 89
+      ItemIndex = 95
      TabOrder = 0
      Text = 'Arial'
    end
@ -372,7 +372,6 @@ object MainForm: TMainForm
      DropDownCount = 24
      ItemIndex = 0
      TabOrder = 2
-      Text = 'black'
    end
    object BackgroundColorCombobox: TsCellCombobox
      Left = 809
@ -387,7 +386,6 @@ object MainForm: TMainForm
      DropDownCount = 24
      ItemIndex = 0
      TabOrder = 3
-      Text = '(none)'
    end
    object ToolButton45: TToolButton
      Left = 559
@ -643,7 +641,7 @@ object MainForm: TMainForm
  end
  object OpenDialog: TOpenDialog
    DefaultExt = '.xls'
-    Filter = 'All spreadsheet files|*.xls;*.xlsx;*.ods;*.csv|All Excel files (*.xls, *.xlsx)|*.xls;*.xlsx|Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|HTML files (*.html; *.htm)|*.html;*.htm|Comma-delimited files (*.csv)|*.csv'
+    Filter = 'All spreadsheet files|*.xls;*.xlsx;*.ods;*.csv|All Excel files (*.xls, *.xlsx)|*.xls;*.xlsx|Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel XP/2003 XML spreadsheet (*.xml)|*.xml|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|HTML files (*.html; *.htm)|*.html;*.htm|Comma-separated text files (*.csv; *.txt)|*.csv;*.txt'
    Options = [ofExtensionDifferent, ofEnableSizing, ofViewDetail]
    left = 312
    top = 160
@ -945,7 +943,7 @@ object MainForm: TMainForm
    object AcFileOpen: TFileOpen
      Category = 'File'
      Caption = '&Open ...'
-      Dialog.Filter = 'All supported spreadsheet files|*.xls;*.xlsx;*.ods;*.csv;*.html;*.htm|All Excel files (*.xls, *.xlsx)|*.xls;*.xlsx|Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited files (*.csv)|*.csv|HTML files (*.html; *.htm)|*.html;*.htm'
+      Dialog.Filter = 'All spreadsheet files|*.xls;*.xlsx;*.ods;*.csv|All Excel files (*.xls, *.xlsx)|*.xls;*.xlsx|Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel XP/2003 XML spreadsheet (*.xml)|*.xml|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|HTML files (*.html; *.htm)|*.html;*.htm|Comma-separated text files (*.csv; *.txt)|*.csv;*.txt'
      Dialog.Options = [ofExtensionDifferent, ofFileMustExist, ofEnableSizing, ofViewDetail]
      Hint = 'Open spreadsheet file'
      ImageIndex = 44
@ -956,7 +954,7 @@ object MainForm: TMainForm
      Category = 'File'
      Caption = 'Save &as ...'
      Dialog.Title = 'AcSaveFileAs'
-      Dialog.Filter = 'Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited files (*.csv)|*.csv|HTML files (*.html; *.htm)|*.html;*.htm|WikiTable (WikiMedia-Format, *.wikitable_wikimedia)|*.wikitable_wikimedia'
+      Dialog.Filter = 'Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel XP/2003 XML spreadsheets (*.xml)|*.xml|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited files (*.csv)|*.csv|HTML files (*.html; *.htm)|*.html;*.htm|WikiTable (WikiMedia-Format, *.wikitable_wikimedia)|*.wikitable_wikimedia'
      Hint = 'Save spreadsheet'
      ImageIndex = 45
      BeforeExecute = AcFileSaveAsBeforeExecute
--- a/components/fpspreadsheet/examples/visual/fpsctrls/main.pas
+++ b/components/fpspreadsheet/examples/visual/fpsctrls/main.pas
@ -415,13 +415,14 @@ begin
  case AcFileOpen.Dialog.FilterIndex of
    1: WorkbookSource.AutoDetectFormat := true;      // All spreadsheet files
    2: WorkbookSource.AutoDetectFormat := true;      // All Excel files
-    3: WorkbookSource.FileFormat := sfOOXML;         // Excel 2007+
-    4: WorkbookSource.FileFormat := sfExcel8;        // Excel 97-2003
-    5: WorkbookSource.FileFormat := sfExcel5;        // Excel 5.0
-    6: WorkbookSource.FileFormat := sfExcel2;        // Excel 2.1
-    7: WorkbookSource.FileFormat := sfOpenDocument;  // Open/LibreOffice
-    8: WorkbookSource.FileFormat := sfCSV;           // Text files
-//    9: WorkbookSource.FileFormat := sfHTML;          // HTML files
+    3: WorkbookSource.FileFormat := sfOOXML;         // Excel 2007+ (OOXML)
+    4: WorkbookSource.FileFormat := sfExcelXML;      // Excel XP, 2003 (ExcelXML)
+    5: WorkbookSource.FileFormat := sfExcel8;        // Excel 97-2003
+    6: WorkbookSource.FileFormat := sfExcel5;        // Excel 5.0
+    7: WorkbookSource.FileFormat := sfExcel2;        // Excel 2.1
+    8: WorkbookSource.FileFormat := sfOpenDocument;  // Open/LibreOffice
+    9: WorkbookSource.FileFormat := sfCSV;           // Text files
+   10: WorkbookSource.FileFormat := sfHTML;          // HTML files
  end;
  WorkbookSource.FileName := UTF8ToAnsi(AcFileOpen.Dialog.FileName);  // this loads the file
  UpdateCaption;
@ -436,13 +437,14 @@ begin
  try
    case AcFileSaveAs.Dialog.FilterIndex of
      1: fmt := sfOOXML;
-      2: fmt := sfExcel8;
-      3: fmt := sfExcel5;
-      4: fmt := sfExcel2;
-      5: fmt := sfOpenDocument;
-      6: fmt := sfCSV;
-      7: fmt := sfHTML;
-      8: fmt := sfWikiTable_WikiMedia;
+      2: fmt := sfExcelXML;
+      3: fmt := sfExcel8;
+      4: fmt := sfExcel5;
+      5: fmt := sfExcel2;
+      6: fmt := sfOpenDocument;
+      7: fmt := sfCSV;
+      8: fmt := sfHTML;
+      9: fmt := sfWikiTable_WikiMedia;
    end;
    WorkbookSource.SaveToSpreadsheetFile(UTF8ToAnsi(AcFileSaveAs.Dialog.FileName), fmt);
    UpdateCaption;
--- a/components/fpspreadsheet/fpsallformats.pas
+++ b/components/fpspreadsheet/fpsallformats.pas
@ -10,7 +10,7 @@ unit fpsallformats;
 interface

 uses
-  xlsbiff2, xlsbiff5, xlsbiff8, fpsopendocument, xlsxooxml, wikitable,
+  xlsbiff2, xlsbiff5, xlsbiff8, xlsxml, fpsopendocument, xlsxooxml, wikitable,
  fpscsv, fpshtml;

 implementation
--- a/components/fpspreadsheet/fpsreaderwriter.pas
+++ b/components/fpspreadsheet/fpsreaderwriter.pas
@ -102,7 +102,7 @@ type
    procedure ListAllNumFormats; virtual;

    { Helpers for writing }
-    procedure WriteCellToStream(AStream: TStream; ACell: PCell);
+    procedure WriteCellToStream(AStream: TStream; ACell: PCell); virtual;
    procedure WriteCellsToStream(AStream: TStream; ACells: TsCells);

    { Record writing methods }
--- a/components/fpspreadsheet/fpstypes.pas
+++ b/components/fpspreadsheet/fpstypes.pas
@ -18,7 +18,7 @@ uses

 type
  {@@ File formats supported by fpspreadsheet }
-  TsSpreadsheetFormat = (sfExcel2, sfExcel5, sfExcel8,
+  TsSpreadsheetFormat = (sfExcel2, sfExcel5, sfExcel8, sfExcelXML,
   sfOOXML, sfOpenDocument, sfCSV, sfHTML,
   sfWikiTable_Pipes, sfWikiTable_WikiMedia);

@ -33,8 +33,10 @@ type
  end;

 const
-  {@@ Default binary <b>Excel</b> file extension}
+  {@@ Default binary <b>Excel</b> file extension (<= Excel 97) }
  STR_EXCEL_EXTENSION = '.xls';
+  {@@ Default xml <b>Excel</v> file extension (Excel XP, 2003) }
+  STR_XML_EXCEL_EXTENSION = '.xml';
  {@@ Default xml <b>Excel</b> file extension (>= Excel 2007) }
  STR_OOXML_EXCEL_EXTENSION = '.xlsx';
  {@@ Default <b>OpenDocument</b> spreadsheet file extension }
--- a/components/fpspreadsheet/fpsutils.pas
+++ b/components/fpspreadsheet/fpsutils.pas
@ -171,6 +171,7 @@ var
  {@@ FPC format settings for which all strings have been converted to UTF8 }
  UTF8FormatSettings: TFormatSettings;

+
 implementation

 uses
--- a/components/fpspreadsheet/xlsxml.pas
+++ b/components/fpspreadsheet/xlsxml.pas
@ -0,0 +1,575 @@
+unit xlsxml;
+
+{$ifdef fpc}
+  {$mode objfpc}{$H+}
+{$endif}
+
+interface
+
+uses
+  Classes, SysUtils,
+  laz2_xmlread, laz2_DOM,
+  fpsTypes, fpspreadsheet, fpsReaderWriter, xlsCommon;
+
+type
+
+  { TsSpreadExcelXMLWriter }
+
+  TsSpreadExcelXMLWriter = class(TsCustomSpreadWriter)
+  private
+    FDateMode: TDateMode;
+    FPointSeparatorSettings: TFormatSettings;
+    procedure WriteCells(AStream: TStream; AWorksheet: TsWorksheet);
+    procedure WriteStyle(AStream: TStream; AIndex: Integer);
+    procedure WriteStyles(AStream: TStream);
+    procedure WriteWorksheet(AStream: TStream; AWorksheet: TsWorksheet);
+
+  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: TsWorkbook); override;
+    procedure WriteToFile(const AFileName: string; const AOverwriteExisting: Boolean = False); override;
+    procedure WriteToStream(AStream: TStream); override;
+
+  end;
+
+  TExcelXmlSettings = record
+    DateMode: TDateMode;
+  end;
+
+var
+  ExcelXmlSettings: TExcelXmlSettings = (
+    DateMode: dm1900;
+  );
+
+
+implementation
+
+uses
+  StrUtils, Math,
+  fpsStrings, fpsUtils, fpsStreams, fpsNumFormat;
+
+const
+  FMT_OFFSET = 61;
+
+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 Exception.Create('Content type error in cell ' + GetCellString(ACell^.Row, ACell^.Col));
+  end;
+end;
+
+{@@ ----------------------------------------------------------------------------
+  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: TsWorkbook);
+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;
+
+procedure TsSpreadExcelXMLWriter.WriteBlank(AStream: TStream;
+  const ARow, ACol: Cardinal; ACell: PCell);
+var
+  styleStr: String;
+begin
+  if ACell^.FormatIndex > 0 then
+    styleStr := Format(' ss:StyleID="s%d"', [ACell^.FormatIndex + FMT_OFFSET]) else
+    styleStr := '';
+  AppendToStream(AStream, Format(
+    '    <Cell%s />' + LineEnding,
+    [styleStr])
+  );
+end;
+
+procedure TsSpreadExcelXMLWriter.WriteBool(AStream: TStream;
+  const ARow, ACol: Cardinal; const AValue: boolean; ACell: PCell);
+var
+  valueStr: String;
+  formulaStr: String;
+  cctStr: String;
+  stylestr: String;
+begin
+  valueStr := StrUtils.IfThen(AValue, '1', '0');
+  cctStr := 'Boolean';
+  formulaStr := '';
+  if HasFormula(ACell) then
+  begin
+    formulaStr := Format(' ss:Formula="=%s"', [ACell^.FormulaValue]);
+    cctStr := GetCellContentTypeStr(ACell);
+  end;
+  if ACell^.FormatIndex > 0 then
+    styleStr := Format(' ss:StyleID="s%d"', [ACell^.FormatIndex + FMT_OFFSET]) else
+    styleStr := '';
+
+  AppendToStream(AStream, Format(
+    '    <Cell%s%s><Data ss:Type="%s">%s</Data></Cell>' + LineEnding,
+    [styleStr, formulaStr, cctStr, valueStr]));
+end;
+
+procedure TsSpreadExcelXMLWriter.WriteCells(AStream: TStream; AWorksheet: TsWorksheet);
+var
+  c, c1, c2: Cardinal;
+  r, r1, r2: Cardinal;
+  cell: PCell;
+begin
+  r1 := 0;
+  c1 := 0;
+  r2 := AWorksheet.GetLastRowIndex;
+  c2 := AWorksheet.GetLastColIndex;
+  AppendToStream(AStream,
+          '<Table>' + LineEnding);
+  for c := c1 to c2 do
+    AppendToStream(AStream,
+          '  <Column ss:Width="80" />' + LineEnding);
+
+  for r := r1 to r2 do
+  begin
+    AppendToStream(AStream,
+          '  <Row>' + LineEnding);
+    for c := c1 to c2 do
+    begin
+      cell := AWorksheet.FindCell(r, c);
+      if cell = nil then
+        AppendToStream(AStream,
+          '    <Cell />' + LineEnding)
+      else
+        WriteCellToStream(AStream, cell);
+    end;
+    AppendToStream(AStream,
+          '  </Row>' + LineEnding);
+  end;
+
+  AppendToStream(AStream,
+          '</Table>' + LineEnding);
+end;
+
+procedure TsSpreadExcelXMLWriter.WriteCellToStream(AStream: TStream; ACell: PCell);
+begin
+  case ACell^.ContentType of
+    cctBool:
+      WriteBool(AStream, ACell^.Row, ACell^.Col, ACell^.BoolValue, ACell);
+    cctDateTime:
+      WriteDateTime(AStream, ACell^.Row, ACell^.Col, ACell^.DateTimeValue, ACell);
+    cctEmpty:
+      WriteBlank(AStream, ACell^.Row, ACell^.Col, ACell);
+    cctError:
+      WriteError(AStream, ACell^.Row, ACell^.Col, ACell^.ErrorValue, ACell);
+    cctNumber:
+      WriteNumber(AStream, ACell^.Row, ACell^.Col, ACell^.NumberValue, ACell);
+    cctUTF8String:
+      WriteLabel(AStream, ACell^.Row, ACell^.Col, ACell^.UTF8StringValue, ACell);
+  end;
+
+  if FWorksheet.ReadComment(ACell) <> '' then
+    WriteComment(AStream, ACell);
+end;
+
+procedure TsSpreadExcelXMLWriter.WriteDateTime(AStream: TStream;
+  const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell);
+var
+  valueStr: String;
+  formulaStr: String;
+  cctStr: String;
+  styleStr: STring;
+  ExcelDate: TDateTime;
+  nfp: TsNumFormatParams;
+  fmt: PsCellFormat;
+begin
+  ExcelDate := AValue;
+  fmt := FWorkbook.GetPointerToCellFormat(ACell^.FormatIndex);
+  // Times have an offset by 1 day - for some unknown reason.
+  if (fmt <> nil) and (uffNumberFormat in fmt^.UsedFormattingFields) then
+  begin
+    nfp := FWorkbook.GetNumberFormat(fmt^.NumberFormatIndex);
+    if IsTimeIntervalFormat(nfp) or IsTimeFormat(nfp) then
+      ExcelDate := AValue + 1.0;
+  end;
+  valueStr := FormatDateTime('yyyy-mm-dd"T"hh:nn:ss.zzz', ExcelDate);
+
+  cctStr := 'DateTime';
+  formulaStr := '';
+  if HasFormula(ACell) then
+  begin
+    formulaStr := Format(' ss:Formula="=%s"', [ACell^.FormulaValue]);
+    cctStr := GetCellContentTypeStr(ACell);
+  end;
+  if ACell^.FormatIndex > 0 then
+    styleStr := Format(' ss:StyleID="s%d"', [ACell^.FormatIndex + FMT_OFFSET]) else
+    styleStr := '';
+
+  AppendToStream(AStream, Format(
+    '    <Cell%s%s><Data ss:Type="%s">%s</Data></Cell>' + LineEnding,
+    [styleStr, formulaStr, cctStr, valueStr])
+  );
+end;
+
+procedure TsSpreadExcelXMLWriter.WriteError(AStream: TStream;
+  const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell);
+var
+  valueStr: String;
+  cctStr: String;
+  formulaStr: String;
+  styleStr: String;
+begin
+  valueStr := GetErrorValueStr(AValue);
+  formulaStr := '';
+  cctStr := 'Error';
+  if HasFormula(ACell) then
+  begin
+    cctStr := GetCellContentTypeStr(ACell);
+    formulaStr := Format(' ss:Formula="=%s"', [ACell^.FormulaValue]);
+  end;
+  if ACell^.FormatIndex > 0 then
+    styleStr := Format(' ss:StyleID="s%d"', [ACell^.FormatIndex + FMT_OFFSET]) else
+    styleStr := '';
+
+  AppendToStream(AStream, Format(
+    '    <Cell%s%s><Data ss:Type="%s">%s</Data></Cell>' + LineEnding,
+    [styleStr, formulaStr, cctStr, valueStr])
+  );
+end;
+
+procedure TsSpreadExcelXMLWriter.WriteLabel(AStream: TStream; const ARow,
+  ACol: Cardinal; const AValue: string; ACell: PCell);
+var
+  valueStr: String;
+  cctStr: String;
+  formulaStr: String;
+  styleStr: String;
+begin
+  valueStr := AValue;
+  if not ValidXMLText(valueStr) then
+    Workbook.AddErrorMsg(
+      rsInvalidCharacterInCell, [
+      GetCellString(ARow, ACol)
+    ]);
+  cctStr := 'String';
+
+  if HasFormula(ACell) then
+  begin
+    cctStr := GetCellContentTypeStr(ACell);
+    formulaStr := Format(' ss:Formula="=%s"', [ACell^.FormulaValue]);
+  end;
+
+  if ACell^.FormatIndex > 0 then
+    styleStr := Format(' ss:StyleID="s%d"', [ACell^.FormatIndex + FMT_OFFSET]) else
+    styleStr := '';
+
+  AppendToStream(AStream, Format(
+    '    <Cell%s%s><Data ss:Type="%s">%s</Data></Cell>' + LineEnding,
+    [styleStr, formulaStr, cctStr, valueStr])
+  );
+end;
+
+
+procedure TsSpreadExcelXMLWriter.WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
+  const AValue: double; ACell: PCell);
+var
+  formulaStr: String;
+  cctStr: String;
+  styleStr: String;
+begin
+  cctStr := 'Number';
+  if HasFormula(ACell) then
+  begin
+    cctStr := GetCellContentTypeStr(ACell);
+    formulaStr := Format(' ss:Formula="=%s"', [ACell^.FormulaValue]);
+  end;
+  if ACell^.FormatIndex > 0 then
+    styleStr := Format(' ss:StyleID="s%d"', [ACell^.FormatIndex + FMT_OFFSET]) else
+    styleStr := '';
+
+  AppendToStream(AStream, Format(
+    '    <Cell%s%s><Data ss:Type="%s">%g</Data></Cell>' + LineEnding,
+    [styleStr, formulaStr, cctStr, AValue], FPointSeparatorSettings)
+  );
+end;
+
+procedure TsSpreadExcelXMLWriter.WriteStyle(AStream: TStream; AIndex: Integer);
+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',
+    'Gray75', 'Gray50', 'Gray25', 'Gray12', '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
+  );
+var
+  fmt: PsCellFormat;
+  deffnt, fnt: TsFont;
+  s, fmtVert, fmtHor, fmtWrap, fmtRot: String;
+  nfp: TsNumFormatParams;
+  fill: TsFillPattern;
+  cb: TsCellBorder;
+  cbs: TsCellBorderStyle;
+begin
+  deffnt := FWorkbook.GetDefaultFont;
+  if AIndex = 0 then
+  begin
+    AppendToStream(AStream, Format(
+      '  <Style ss:ID="Default" ss:Name="Normal">' + LineEnding +
+      '    <Aligment ss:Vertical="Bottom" />' + LineEnding +
+      '    <Borders />' + LineEnding +
+      '    <Font ss:FontName="%s" x:Family="Swiss" ss:Size="%d" ss:Color="%s" />' + LineEnding +
+      '    <Interior />' + LineEnding +
+      '    <NumberFormat />' + LineEnding +
+      '    <Protection />' + LineEnding +
+      '  </Style>' + LineEnding,
+      [deffnt.FontName, round(deffnt.Size), ColorToHTMLColorStr(deffnt.Color)] )
+    )
+  end else
+  begin
+    AppendToStream(AStream, Format(
+      '  <Style ss:ID="s%d">' + LineEnding, [AIndex + FMT_OFFSET]));
+
+    fmt := FWorkbook.GetPointerToCellFormat(AIndex);
+
+    // Horizontal alignment
+    fmtHor := '';
+    if uffHorAlign in fmt^.UsedFormattingFields then
+      case fmt^.HorAlignment of
+        haDefault: ;
+        haLeft   : fmtHor := 'ss:Horizontal="Left"';
+        haCenter : fmtHor := 'ss:Horizontal="Center"';
+        haRight  : fmtHor := 'ss:Horizontal="Right"';
+        else
+          raise Exception.Create('[TsSpreadXMLWriter.WriteStyle] Horizontal alignment cannot be handled.');
+      end;
+
+    // Vertical alignment
+    fmtVert := 'ss:Vertical="Bottom"';
+    if uffVertAlign in fmt^.UsedFormattingFields then
+      case fmt^.VertAlignment of
+        vaDefault: ;
+        vaTop    : fmtVert := 'ss:Vertical="Top"';
+        vaCenter : fmtVert := 'ss:Vertical="Center"';
+        vaBottom : ;
+        else
+          raise Exception.Create('[TsSpreadXMLWriter.WriteStyle] Vertical alignment cannot be handled.');
+      end;
+
+    // Wrap text
+    if uffWordwrap in fmt^.UsedFormattingFields then
+      fmtWrap := 'ss:WrapText="1"' else
+      fmtWrap := '';
+
+    // Text rotation
+    fmtRot := '';
+    if uffTextRotation in fmt^.UsedFormattingFields then
+      case fmt^.TextRotation of
+        rt90DegreeClockwiseRotation        : fmtRot := 'ss:Rotate="-90"';
+        rt90DegreeCounterClockwiseRotation : fmtRot := 'ss:Rotate="90"';
+        rtStacked                          : fmtRot := 'ss:VerticalText="1"';
+      end;
+
+    // Write all the alignment, text rotation and wordwrap attributes to stream
+    AppendToStream(AStream, Format(
+      '    <Alignment %s%s%s%s />' + LineEnding,
+      [fmtHor, fmtVert, fmtWrap, fmtRot])
+    );
+
+    // Font
+    if (uffFont in fmt^.UsedFormattingFields) then
+    begin
+      fnt := FWorkbook.GetFont(fmt^.FontIndex);
+      s := '';
+      if fnt.FontName <> deffnt.FontName then
+        s := s + Format('ss:FontName="%s" ', [fnt.FontName]);
+      if not SameValue(fnt.Size, deffnt.Size, 1E-3) then
+        s := s + Format('ss:Size="%g" ', [fnt.Size], FPointSeparatorSettings);
+      if fnt.Color <> deffnt.Color then
+        s := s + Format('ss:Color="%s" ', [ColorToHTMLColorStr(fnt.Color)]);
+      if s <> '' then
+        AppendToStream(AStream,
+          '    <Font ' + s + '/>' + LineEnding);
+    end;
+
+    // Number Format
+    if (uffNumberFormat in fmt^.UsedFormattingFields) then
+    begin
+      nfp := FWorkbook.GetNumberFormat(fmt^.NumberFormatIndex);
+      AppendToStream(AStream, Format(
+        '    <NumberFormat ss:Format="%s"/>' + LineEnding, [nfp.NumFormatStr]));
+    end;
+
+    // Background
+    if (uffBackground in fmt^.UsedFormattingFields) then
+    begin
+      fill := fmt^.Background;
+      s := 'ss:Color="' + ColorToHTMLColorStr(fill.BgColor) + '" ';
+      if not (fill.Style in [fsNoFill, fsSolidFill]) then
+        s := s + 'ss:PatternColor="' + ColorToHTMLColorStr(fill.FgColor) + '" ';
+      s := s + 'ss:Pattern="' + FILL_NAMES[fill.Style] + '"';
+      AppendToStream(AStream,
+        '    <Interior ' + s + '/>')
+    end;
+
+    // Borders
+    if (uffBorder in fmt^.UsedFormattingFields) then
+    begin
+      s := '';
+      for cb in TsCellBorder do
+        if cb in fmt^.Border then begin
+          cbs := fmt^.BorderStyles[cb];
+          s := s + Format('      <Border ss:Position="%s" ss:LineStyle="%s"', [
+            BORDER_NAMES[cb], LINE_STYLES[cbs.LineStyle]]);
+          if fmt^.BorderStyles[cb].LineStyle <> lsHair then
+            s := Format('%s ss:Weight="%d"', [s, LINE_WIDTHS[cbs.LineStyle]]);
+          if fmt^.BorderStyles[cb].Color <> scBlack then
+            s := Format('%s ss:Color="%s"', [s, ColorToHTMLColorStr(cbs.Color)]);
+          s := s + '/>' + LineEnding;
+        end;
+      if s <> '' then
+        AppendToStream(AStream,
+          '    <Borders>' + LineEnding + s +
+          '    </Borders>' + LineEnding);
+    end;
+
+    AppendToStream(AStream,
+      '  </Style>' + LineEnding);
+  end;
+end;
+
+procedure TsSpreadExcelXMLWriter.WriteStyles(AStream: TStream);
+var
+  i: Integer;
+begin
+  AppendToStream(AStream,
+    '<Styles>' + LineEnding);
+  for i:=0 to FWorkbook.GetNumCellFormats-1 do WriteStyle(AStream, i);
+  AppendToStream(AStream,
+    '</Styles>' + LineEnding);
+end;
+
+{@@ ----------------------------------------------------------------------------
+  Writes an ExcelXML document to the file
+-------------------------------------------------------------------------------}
+procedure TsSpreadExcelXMLWriter.WriteToFile(const AFileName: string;
+  const AOverwriteExisting: Boolean);
+var
+  stream: TStream;
+  mode: word;
+begin
+  mode := fmCreate or fmShareDenyNone;
+  if AOverwriteExisting
+    then mode := mode or fmOpenWrite;
+
+  if (boBufStream in Workbook.Options) then
+    stream := TBufStream.Create(AFileName, mode)
+  else
+    stream := TFileStream.Create(AFileName, mode);
+
+  try
+    WriteToStream(stream);
+  finally
+    FreeAndNil(stream);
+  end;
+end;
+
+{@@ ----------------------------------------------------------------------------
+  Writes an ExcelXML document to a stream
+-------------------------------------------------------------------------------}
+procedure TsSpreadExcelXMLWriter.WriteToStream(AStream: TStream);
+var
+  i: Integer;
+begin
+  AppendToStream(AStream,
+    '<?xml version="1.0"?>' + LineEnding +
+    '<?mso-application progid="Excel.Sheet"?>' + LineEnding
+  );
+  AppendToStream(AStream,
+    '<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"' + LineEnding +
+    ' xmlns:o="urn:schemas-microsoft-com:office:office"' + LineEnding +
+    ' xmlns:x="urn:schemas-microsoft-com:office:excel"' + LineEnding +
+    ' xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"' + LineEnding +
+    ' xmlns:html="http://www.w3.org/TR/REC-html40">' + LineEnding);
+
+  WriteStyles(AStream);
+
+  for i:=0 to FWorkbook.GetWorksheetCount-1 do begin
+    FWorksheet := FWorkbook.GetWorksheetByIndex(i);
+    WriteWorksheet(AStream, FWorksheet);
+  end;
+
+  AppendToStream(AStream,
+    '</Workbook>');
+end;
+
+procedure TsSpreadExcelXMLWriter.WriteWorksheet(AStream: TStream;
+  AWorksheet: TsWorksheet);
+begin
+  AppendToStream(AStream, Format(
+    '<Worksheet ss:Name="%s">' + LineEnding, [AWorksheet.Name])
+  );
+  WriteCells(AStream, AWorksheet);
+  AppendToStream(AStream,
+    '</Worksheet>' + LineEnding
+  );
+end;
+
+
+initialization
+
+  // Registers this reader / writer in fpSpreadsheet
+  RegisterSpreadFormat(nil, TsSpreadExcelXMLWriter, sfExcelXML);
+
+end.