From 0dc5a6e45edb98e972c1a6fe13826e999d3a8f15 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sat, 19 Sep 2015 22:55:18 +0000 Subject: [PATCH] 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 --- .../examples/visual/fpsctrls/main.lfm | 10 +- .../examples/visual/fpsctrls/main.pas | 30 +- components/fpspreadsheet/fpsallformats.pas | 2 +- components/fpspreadsheet/fpsreaderwriter.pas | 2 +- components/fpspreadsheet/fpstypes.pas | 6 +- components/fpspreadsheet/fpsutils.pas | 1 + components/fpspreadsheet/xlsxml.pas | 575 ++++++++++++++++++ 7 files changed, 602 insertions(+), 24 deletions(-) create mode 100644 components/fpspreadsheet/xlsxml.pas diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm b/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm index 9b26ce42c..8a7dcf40c 100644 --- 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 diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/main.pas b/components/fpspreadsheet/examples/visual/fpsctrls/main.pas index f0b885c9e..7cd4e1187 100644 --- 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; diff --git a/components/fpspreadsheet/fpsallformats.pas b/components/fpspreadsheet/fpsallformats.pas index dc96c71fc..6f91b28b7 100755 --- 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 diff --git a/components/fpspreadsheet/fpsreaderwriter.pas b/components/fpspreadsheet/fpsreaderwriter.pas index 376c2f225..79d76fd6c 100644 --- 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 } diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas index d3a63c033..75b10ba71 100644 --- 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 Excel file extension} + {@@ Default binary Excel file extension (<= Excel 97) } STR_EXCEL_EXTENSION = '.xls'; + {@@ Default xml Excel file extension (Excel XP, 2003) } + STR_XML_EXCEL_EXTENSION = '.xml'; {@@ Default xml Excel file extension (>= Excel 2007) } STR_OOXML_EXCEL_EXTENSION = '.xlsx'; {@@ Default OpenDocument spreadsheet file extension } diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index d1840278f..6cc416bdd 100644 --- 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 diff --git a/components/fpspreadsheet/xlsxml.pas b/components/fpspreadsheet/xlsxml.pas new file mode 100644 index 000000000..0067a8cb8 --- /dev/null +++ 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( + ' ' + 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( + ' %s' + 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, + '' + LineEnding); + for c := c1 to c2 do + AppendToStream(AStream, + ' ' + LineEnding); + + for r := r1 to r2 do + begin + AppendToStream(AStream, + ' ' + LineEnding); + for c := c1 to c2 do + begin + cell := AWorksheet.FindCell(r, c); + if cell = nil then + AppendToStream(AStream, + ' ' + LineEnding) + else + WriteCellToStream(AStream, cell); + end; + AppendToStream(AStream, + ' ' + LineEnding); + end; + + AppendToStream(AStream, + '
' + 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( + ' %s' + 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( + ' %s' + 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( + ' %s' + 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( + ' %g' + 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( + ' ' + LineEnding, + [deffnt.FontName, round(deffnt.Size), ColorToHTMLColorStr(deffnt.Color)] ) + ) + end else + begin + AppendToStream(AStream, Format( + ' ' + LineEnding); + end; +end; + +procedure TsSpreadExcelXMLWriter.WriteStyles(AStream: TStream); +var + i: Integer; +begin + AppendToStream(AStream, + '' + LineEnding); + for i:=0 to FWorkbook.GetNumCellFormats-1 do WriteStyle(AStream, i); + AppendToStream(AStream, + '' + 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, + '' + LineEnding + + '' + LineEnding + ); + AppendToStream(AStream, + '' + LineEnding); + + WriteStyles(AStream); + + for i:=0 to FWorkbook.GetWorksheetCount-1 do begin + FWorksheet := FWorkbook.GetWorksheetByIndex(i); + WriteWorksheet(AStream, FWorksheet); + end; + + AppendToStream(AStream, + ''); +end; + +procedure TsSpreadExcelXMLWriter.WriteWorksheet(AStream: TStream; + AWorksheet: TsWorksheet); +begin + AppendToStream(AStream, Format( + '' + LineEnding, [AWorksheet.Name]) + ); + WriteCells(AStream, AWorksheet); + AppendToStream(AStream, + '' + LineEnding + ); +end; + + +initialization + + // Registers this reader / writer in fpSpreadsheet + RegisterSpreadFormat(nil, TsSpreadExcelXMLWriter, sfExcelXML); + +end.