From ea36d2e0894caa4407867f77551132cf65e1208a Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 25 Feb 2015 09:43:37 +0000 Subject: [PATCH] fpspreadsheet: Shorten fpspreadsheet.pas by putting NumFormatList and CustomReader/Writer to separate units git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3963 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/fpsctrls/demo_ctrls.lpi | 2 +- .../fpspreadsheet/examples/fpsctrls/main.pas | 4 + .../examples/fpsgrid_no_install/mainfrm.pas | 4 + .../examples/ooxmldemo/ooxmlread.lpr | 1 + .../examples/other/demo_write_formula.pas | 3 +- .../examples/spready/mainform.pas | 2 +- .../examples/wikitablemaker/wtmain.lfm | 7 - .../examples/wikitablemaker/wtmain.pas | 3 +- components/fpspreadsheet/fpsactions.pas | 2 +- components/fpspreadsheet/fpscsv.pas | 2 +- components/fpspreadsheet/fpsnumformat.pas | 562 ++++++++ .../fpspreadsheet/fpsnumformatparser.pas | 86 +- components/fpspreadsheet/fpsopendocument.pas | 4 +- components/fpspreadsheet/fpspreadsheet.pas | 1199 +---------------- components/fpspreadsheet/fpsreaderwriter.pas | 692 ++++++++++ components/fpspreadsheet/fpsutils.pas | 23 + components/fpspreadsheet/fpsxmlcommon.pas | 2 +- .../fpspreadsheet/laz_fpspreadsheet.lpk | 10 +- .../fpspreadsheet/laz_fpspreadsheet.pas | 3 +- .../fpspreadsheet/tests/formattests.pas | 2 +- .../fpspreadsheet/tests/spreadtestcli.lpi | 10 +- .../fpspreadsheet/tests/spreadtestcli.lpr | 3 +- components/fpspreadsheet/wikitable.pas | 2 +- components/fpspreadsheet/xlsbiff2.pas | 4 +- components/fpspreadsheet/xlsbiff5.pas | 8 +- components/fpspreadsheet/xlsbiff8.pas | 8 +- components/fpspreadsheet/xlscommon.pas | 4 +- components/fpspreadsheet/xlsxooxml.pas | 3 +- 28 files changed, 1381 insertions(+), 1274 deletions(-) create mode 100644 components/fpspreadsheet/fpsnumformat.pas create mode 100644 components/fpspreadsheet/fpsreaderwriter.pas diff --git a/components/fpspreadsheet/examples/fpsctrls/demo_ctrls.lpi b/components/fpspreadsheet/examples/fpsctrls/demo_ctrls.lpi index 4eb378a3f..b20a99e4c 100644 --- a/components/fpspreadsheet/examples/fpsctrls/demo_ctrls.lpi +++ b/components/fpspreadsheet/examples/fpsctrls/demo_ctrls.lpi @@ -9,7 +9,7 @@ <ResourceType Value="res"/> <UseXPManifest Value="True"/> - <Icon Value="0"/> + <Icon Value="-1"/> </General> <i18n> <EnableI18N LFM="False"/> diff --git a/components/fpspreadsheet/examples/fpsctrls/main.pas b/components/fpspreadsheet/examples/fpsctrls/main.pas index a23d097f2..fc0139818 100644 --- a/components/fpspreadsheet/examples/fpsctrls/main.pas +++ b/components/fpspreadsheet/examples/fpsctrls/main.pas @@ -309,6 +309,10 @@ implementation {$R *.lfm} +uses + fpsUtils; + + { TMainForm } { Loads the spreadsheet file selected by the AcFileOpen action } diff --git a/components/fpspreadsheet/examples/fpsgrid_no_install/mainfrm.pas b/components/fpspreadsheet/examples/fpsgrid_no_install/mainfrm.pas index d91f9673a..42f45c22b 100644 --- a/components/fpspreadsheet/examples/fpsgrid_no_install/mainfrm.pas +++ b/components/fpspreadsheet/examples/fpsgrid_no_install/mainfrm.pas @@ -41,6 +41,10 @@ implementation {$R *.lfm} +uses + fpsUtils; + + { TForm1 } procedure TForm1.FormCreate(Sender: TObject); diff --git a/components/fpspreadsheet/examples/ooxmldemo/ooxmlread.lpr b/components/fpspreadsheet/examples/ooxmldemo/ooxmlread.lpr index d34df4c39..22978992c 100644 --- a/components/fpspreadsheet/examples/ooxmldemo/ooxmlread.lpr +++ b/components/fpspreadsheet/examples/ooxmldemo/ooxmlread.lpr @@ -57,6 +57,7 @@ begin // Finalization MyWorkbook.Free; + WriteLn('Finished. Press [ENTER] to close...'); ReadLn; end. diff --git a/components/fpspreadsheet/examples/other/demo_write_formula.pas b/components/fpspreadsheet/examples/other/demo_write_formula.pas index 6a28ca5ae..05f6e7e08 100644 --- a/components/fpspreadsheet/examples/other/demo_write_formula.pas +++ b/components/fpspreadsheet/examples/other/demo_write_formula.pas @@ -1,7 +1,8 @@ { test_write_formula.pas -Demonstrates how to write a formula using the fpspreadsheet library +Demonstrates how to write a formula using the fpspreadsheet library in the +"hard way" by means of rpn formulas AUTHORS: Felipe Monteiro de Carvalho } diff --git a/components/fpspreadsheet/examples/spready/mainform.pas b/components/fpspreadsheet/examples/spready/mainform.pas index 3551c99d9..ea399a510 100644 --- a/components/fpspreadsheet/examples/spready/mainform.pas +++ b/components/fpspreadsheet/examples/spready/mainform.pas @@ -354,7 +354,7 @@ implementation uses TypInfo, LCLIntf, LCLType, LCLVersion, fpcanvas, - fpsutils, fpscsv, fpsNumFormatParser, + fpsutils, fpscsv, fpsNumFormat, sFormatSettingsForm, sCSVParamsForm, sSortParamsForm, sfCurrencyForm; const diff --git a/components/fpspreadsheet/examples/wikitablemaker/wtmain.lfm b/components/fpspreadsheet/examples/wikitablemaker/wtmain.lfm index 5c600941f..6777607f1 100644 --- a/components/fpspreadsheet/examples/wikitablemaker/wtmain.lfm +++ b/components/fpspreadsheet/examples/wikitablemaker/wtmain.lfm @@ -725,7 +725,6 @@ object MainFrm: TMainFrm '' ) VisibleSpecialChars = [vscSpace, vscTabAtLast] - SelectedColor.FrameEdges = sfeAround SelectedColor.BackPriority = 50 SelectedColor.ForePriority = 50 SelectedColor.FramePriority = 50 @@ -733,23 +732,17 @@ object MainFrm: TMainFrm SelectedColor.ItalicPriority = 50 SelectedColor.UnderlinePriority = 50 SelectedColor.StrikeOutPriority = 50 - IncrementColor.FrameEdges = sfeAround - HighlightAllColor.FrameEdges = sfeAround BracketHighlightStyle = sbhsBoth BracketMatchColor.Background = clNone BracketMatchColor.Foreground = clNone - BracketMatchColor.FrameEdges = sfeAround BracketMatchColor.Style = [fsBold] FoldedCodeColor.Background = clNone FoldedCodeColor.Foreground = clGray FoldedCodeColor.FrameColor = clGray - FoldedCodeColor.FrameEdges = sfeAround MouseLinkColor.Background = clNone MouseLinkColor.Foreground = clBlue - MouseLinkColor.FrameEdges = sfeAround LineHighlightColor.Background = clNone LineHighlightColor.Foreground = clNone - LineHighlightColor.FrameEdges = sfeAround inline SynLeftGutterPartList1: TSynGutterPartList end end diff --git a/components/fpspreadsheet/examples/wikitablemaker/wtmain.pas b/components/fpspreadsheet/examples/wikitablemaker/wtmain.pas index 979464a22..02e33ba66 100644 --- a/components/fpspreadsheet/examples/wikitablemaker/wtmain.pas +++ b/components/fpspreadsheet/examples/wikitablemaker/wtmain.pas @@ -8,8 +8,7 @@ uses Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Menus, ExtCtrls, ComCtrls, ActnList, Grids, ColorBox, SynEdit, SynEditHighlighter, SynHighlighterHTML, SynHighlighterMulti, - SynHighlighterCss, SynGutterBase, SynGutterMarks, SynGutterLineNumber, - SynGutterChanges, SynGutter, SynGutterCodeFolding, fpspreadsheetgrid, + SynHighlighterCss, SynGutterCodeFolding, fpspreadsheetgrid, fpstypes, fpspreadsheet, fpsallformats; type diff --git a/components/fpspreadsheet/fpsactions.pas b/components/fpspreadsheet/fpsactions.pas index 0e23e2186..08065cf41 100644 --- a/components/fpspreadsheet/fpsactions.pas +++ b/components/fpspreadsheet/fpsactions.pas @@ -479,7 +479,7 @@ implementation uses StdCtrls, ExtCtrls, Buttons, Forms, - fpsutils, fpsnumformatparser, fpsVisualUtils; + fpsUtils, fpsNumFormat, fpsVisualUtils; procedure Register; begin diff --git a/components/fpspreadsheet/fpscsv.pas b/components/fpspreadsheet/fpscsv.pas index 3f9a52b36..55b774d0e 100644 --- a/components/fpspreadsheet/fpscsv.pas +++ b/components/fpspreadsheet/fpscsv.pas @@ -6,7 +6,7 @@ interface uses Classes, SysUtils, - fpstypes, fpspreadsheet, fpsCsvDocument; + fpstypes, fpspreadsheet, fpsReaderWriter, fpsCsvDocument; type TsCSVReader = class(TsCustomSpreadReader) diff --git a/components/fpspreadsheet/fpsnumformat.pas b/components/fpspreadsheet/fpsnumformat.pas new file mode 100644 index 000000000..c4e289c07 --- /dev/null +++ b/components/fpspreadsheet/fpsnumformat.pas @@ -0,0 +1,562 @@ +unit fpsNumFormat; + +{$ifdef fpc} + {$mode objfpc}{$H+} +{$endif} + +interface + +uses + Classes, SysUtils, + fpstypes, fpspreadsheet; + +type + {@@ Contents of a number format record } + TsNumFormatData = class + public + {@@ Excel refers to a number format by means of the format "index". } + Index: Integer; + {@@ OpenDocument refers to a number format by means of the format "name". } + Name: String; + {@@ Identifier of a built-in number format, see TsNumberFormat } + NumFormat: TsNumberFormat; + {@@ String of format codes, such as '#,##0.00', or 'hh:nn'. } + FormatString: string; + end; + + {@@ Specialized list for number format items } + TsCustomNumFormatList = class(TFPList) + private + function GetItem(AIndex: Integer): TsNumFormatData; + procedure SetItem(AIndex: Integer; AValue: TsNumFormatData); + protected + {@@ Workbook from which the number formats are collected in the list. It is + mainly needed to get access to the FormatSettings for easy localization of some + formatting strings. } + FWorkbook: TsWorkbook; + {@@ Identifies the first number format item that is written to the file. Items + having a smaller index are not written. } + FFirstNumFormatIndexInFile: Integer; + {@@ Identifies the index of the next Excel number format item to be written. + Needed for auto-creating of the user-defined Excel number format indexes } + FNextNumFormatIndex: Integer; + procedure AddBuiltinFormats; virtual; + procedure RemoveFormat(AIndex: Integer); + + public + constructor Create(AWorkbook: TsWorkbook); + destructor Destroy; override; + function AddFormat(AFormatIndex: Integer; AFormatName: String; + ANumFormat: TsNumberFormat; AFormatString: String): Integer; overload; + function AddFormat(AFormatIndex: Integer; ANumFormat: TsNumberFormat; + AFormatString: String): Integer; overload; + function AddFormat(AFormatName: String; ANumFormat: TsNumberFormat; + AFormatString: String): Integer; overload; + function AddFormat(ANumFormat: TsNumberFormat; AFormatString: String): Integer; overload; + procedure AnalyzeAndAdd(AFormatIndex: Integer; AFormatString: String); + procedure Clear; + procedure ConvertAfterReading(AFormatIndex: Integer; var AFormatString: String; + var ANumFormat: TsNumberFormat); virtual; + procedure ConvertBeforeWriting(var AFormatString: String; + var ANumFormat: TsNumberFormat); virtual; + procedure Delete(AIndex: Integer); + function Find(ANumFormat: TsNumberFormat; AFormatString: String): Integer; virtual; + function FindByFormatStr(AFormatString: String): Integer; + function FindByIndex(AFormatIndex: Integer): Integer; + function FindByName(AFormatName: String): Integer; + function FormatStringForWriting(AIndex: Integer): String; virtual; + procedure Sort; + + {@@ Workbook from which the number formats are collected in the list. It is + mainly needed to get access to the FormatSettings for easy localization of some + formatting strings. } + property Workbook: TsWorkbook read FWorkbook; + {@@ Identifies the first number format item that is written to the file. Items + having a smaller index are not written. } + property FirstNumFormatIndexInFile: Integer read FFirstNumFormatIndexInFile; + {@@ Number format items contained in the list } + property Items[AIndex: Integer]: TsNumFormatData read GetItem write SetItem; default; + end; + +function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean; +function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; overload; +function IsDateTimeFormat(AFormatStr: String): Boolean; overload; +function IsTimeFormat(AFormat: TsNumberFormat): Boolean; overload; +function IsTimeFormat(AFormatStr: String): Boolean; overload; + + +implementation + +uses + Math, + fpsUtils, fpsNumFormatParser; + +{@@ ---------------------------------------------------------------------------- + Checks whether the given number format code is for currency, + i.e. requires currency symbol. + + @param AFormat Built-in number format identifier to be checked + @return True if AFormat is nfCurrency or nfCurrencyRed, false otherwise. +-------------------------------------------------------------------------------} +function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean; +begin + Result := AFormat in [nfCurrency, nfCurrencyRed]; +end; + +{@@ ---------------------------------------------------------------------------- + Checks whether the given number format code is for date/time values. + + @param AFormat Built-in number format identifier to be checked + @return True if AFormat is a date/time format (such as nfShortTime), + false otherwise +-------------------------------------------------------------------------------} +function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; +begin + Result := AFormat in [{nfFmtDateTime, }nfShortDateTime, nfShortDate, nfLongDate, + nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, nfTimeInterval]; +end; + +{@@ ---------------------------------------------------------------------------- + Checks whether the given string with formatting codes is for date/time values. + + @param AFormatStr String with formatting codes to be checked. + @return True if AFormatStr is a date/time format string (such as 'hh:nn'), + false otherwise +-------------------------------------------------------------------------------} +function IsDateTimeFormat(AFormatStr: string): Boolean; +var + parser: TsNumFormatParser; +begin + parser := TsNumFormatParser.Create(nil, AFormatStr); + try + Result := parser.IsDateTimeFormat; + finally + parser.Free; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Checks whether the given built-in number format code is for time values. + + @param AFormat Built-in number format identifier to be checked + @return True if AFormat represents to a time-format, false otherwise +-------------------------------------------------------------------------------} +function IsTimeFormat(AFormat: TsNumberFormat): boolean; +begin + Result := AFormat in [nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, + nfTimeInterval]; +end; + +{@@ ---------------------------------------------------------------------------- + Checks whether the given string with formatting codes is for time values. + + @param AFormatStr String with formatting codes to be checked + @return True if AFormatStr represents a time-format, false otherwise +-------------------------------------------------------------------------------} +function IsTimeFormat(AFormatStr: String): Boolean; +var + parser: TsNumFormatParser; +begin + parser := TsNumFormatParser.Create(nil, AFormatStr); + try + Result := parser.IsTimeFormat; + finally + parser.Free; + end; +end; + + +{******************************************************************************* +* TsCustomNumFormatList * +*******************************************************************************} + +{@@ ---------------------------------------------------------------------------- + Constructor of the number format list. + + @param AWorkbook The workbook is needed to get access to its "FormatSettings" + for localization of some formatting strings. +-------------------------------------------------------------------------------} +constructor TsCustomNumFormatList.Create(AWorkbook: TsWorkbook); +begin + inherited Create; + FWorkbook := AWorkbook; + AddBuiltinFormats; +end; + +{@@ ---------------------------------------------------------------------------- + Destructor of the number format list: clears the list and destroys the + format items +-------------------------------------------------------------------------------} +destructor TsCustomNumFormatList.Destroy; +begin + Clear; + inherited Destroy; +end; + +{@@ ---------------------------------------------------------------------------- + Adds a number format described by the Excel format index, the ODF format + name, the format string, and the built-in format identifier to the list + and returns the index of the new item. + + @param AFormatIndex Format index to be used by Excel + @param AFormatName Format name to be used by OpenDocument + @param AFormatString String of formatting codes + @param ANumFormat Identifier for built-in number format + @return List index of the new item +-------------------------------------------------------------------------------} +function TsCustomNumFormatList.AddFormat(AFormatIndex: Integer; + AFormatName: String; ANumFormat: TsNumberFormat; AFormatString: String): Integer; +var + item: TsNumFormatData; +begin + item := TsNumFormatData.Create; + item.Index := AFormatIndex; + item.Name := AFormatName; + item.NumFormat := ANumFormat; + item.FormatString := AFormatString; + Result := inherited Add(item); +end; + +{@@ ---------------------------------------------------------------------------- + Adds a number format described by the Excel format index, the format string, + and the built-in format identifier to the list and returns the index of + the new item in the format list. To be used when writing an Excel file. + + @param AFormatIndex Format index to be used by Excel + @param ANumFormat Identifier for built-in number format + @param AFormatString String of formatting codes + @return Index of the new item in the format list +-------------------------------------------------------------------------------} +function TsCustomNumFormatList.AddFormat(AFormatIndex: Integer; + ANumFormat: TsNumberFormat; AFormatString: String): integer; +begin + Result := AddFormat(AFormatIndex, '', ANumFormat, AFormatString); +end; + +{@@ ---------------------------------------------------------------------------- + Adds a number format described by the ODF format name, the format string, + and the built-in format identifier to the list and returns the index of + the new item in the format list. To be used when writing an ODS file. + + @param AFormatName Format name to be used by OpenDocument + @param AFormatString String of formatting codes + @param ANumFormat Identifier for built-in number format + @return Index of the new item in the format list +-------------------------------------------------------------------------------} +function TsCustomNumFormatList.AddFormat(AFormatName: String; + ANumFormat: TsNumberFormat; AFormatString: String): Integer; +begin + if (AFormatString = '') and (ANumFormat <> nfGeneral) then + begin + Result := 0; + exit; + end; + Result := AddFormat(FNextNumFormatIndex, AFormatName, ANumFormat, AFormatString); + inc(FNextNumFormatIndex); +end; + +{@@ ---------------------------------------------------------------------------- + Adds a number format described by the format string, and the built-in + format identifier to the format list and returns the index of the new + item in the list. The Excel format index and ODS format name are auto-generated. + + @param ANumFormat Identifier for built-in number format + @param AFormatString String of formatting codes + @return Index of the new item in the list +-------------------------------------------------------------------------------} +function TsCustomNumFormatList.AddFormat(ANumFormat: TsNumberFormat; + AFormatString: String): Integer; +begin + Result := AddFormat('', ANumFormat, AFormatString); +end; + +{@@ ---------------------------------------------------------------------------- + Adds the builtin format items to the list. The formats must be specified in + a way that is compatible with fpc syntax. + + Conversion of the formatstrings to the syntax used in the destination file + can be done by calling "ConvertAfterReadung" bzw. "ConvertBeforeWriting". + "AddBuiltInFormats" must be called before user items are added. + + Must specify FFirstNumFormatIndexInFile (BIFF5-8, e.g. don't save formats <164) + and must initialize the index of the first user format (FNextNumFormatIndex) + which is automatically incremented when adding user formats. + + In TsCustomNumFormatList nothing is added. +-------------------------------------------------------------------------------} +procedure TsCustomNumFormatList.AddBuiltinFormats; +begin + // must be overridden - see xlscommon as an example. +end; + +{@@ ---------------------------------------------------------------------------- + Called from the reader when a format item has been read from an Excel file. + Determines the number format type, format string etc and converts the + format string to fpc syntax which is used directly for getting the cell text. + + @param AFormatIndex Excel index of the number format read from the file + @param AFormatString String of formatting codes as read fromt the file. +-------------------------------------------------------------------------------} +procedure TsCustomNumFormatList.AnalyzeAndAdd(AFormatIndex: Integer; + AFormatString: String); +var + nf: TsNumberFormat = nfGeneral; +begin + if FindByIndex(AFormatIndex) > -1 then + exit; + + // Analyze & convert the format string, extract infos for internal formatting + ConvertAfterReading(AFormatIndex, AFormatString, nf); + + // Add the new item + AddFormat(AFormatIndex, nf, AFormatString); +end; + +{@@ ---------------------------------------------------------------------------- + Clears the number format list and frees memory occupied by the format items. +-------------------------------------------------------------------------------} +procedure TsCustomNumFormatList.Clear; +var + i: Integer; +begin + for i:=0 to Count-1 do RemoveFormat(i); + inherited Clear; +end; + +{@@ ---------------------------------------------------------------------------- + Takes the format string as it is read from the file and extracts the + built-in number format identifier out of it for use by fpc. + The method also converts the format string to a form that can be used + by fpc's FormatDateTime and FormatFloat. + + The method should be overridden in a class that knows knows more about the + details of the spreadsheet file format. + + @param AFormatIndex Excel index of the number format read + @param AFormatString string of formatting codes extracted from the file data + @param ANumFormat identifier for built-in fpspreadsheet format extracted + from the file data +-------------------------------------------------------------------------------} +procedure TsCustomNumFormatList.ConvertAfterReading(AFormatIndex: Integer; + var AFormatString: String; var ANumFormat: TsNumberFormat); +var + parser: TsNumFormatParser; + fmt: String; + lFormatData: TsNumFormatData; + i: Integer; +begin + i := FindByIndex(AFormatIndex); + if i > 0 then + begin + lFormatData := Items[i]; + fmt := lFormatData.FormatString; + end else + fmt := AFormatString; + + // Analyzes the format string and tries to convert it to fpSpreadsheet format. + parser := TsNumFormatParser.Create(Workbook, fmt); + try + if parser.Status = psOK then + begin + ANumFormat := parser.NumFormat; + AFormatString := parser.FormatString[nfdDefault]; + end else + begin + // Show an error here? + end; + finally + parser.Free; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Is called before collecting all number formats of the spreadsheet and before + writing them to file. Its purpose is to convert the format string as used by fpc + to a format compatible with the spreadsheet file format. + Nothing is changed in the TsCustomNumFormatList, the method needs to be + overridden by a descendant class which known more about the details of the + destination file format. + + Needs to be overridden by a class knowing more about the destination file + format. + + @param AFormatString String of formatting codes. On input in fpc syntax. Is + overwritten on output by format string compatible with + the destination file. + @param ANumFormat Identifier for built-in fpspreadsheet number format +-------------------------------------------------------------------------------} +procedure TsCustomNumFormatList.ConvertBeforeWriting(var AFormatString: String; + var ANumFormat: TsNumberFormat); +begin + Unused(AFormatString, ANumFormat); + // nothing to do here. But see, e.g., xlscommon.TsBIFFNumFormatList +end; + + +{@@ ---------------------------------------------------------------------------- + Deletes a format item from the list, and makes sure that its memory is + released. + + @param AIndex List index of the item to be deleted. +-------------------------------------------------------------------------------} +procedure TsCustomNumFormatList.Delete(AIndex: Integer); +begin + RemoveFormat(AIndex); + Delete(AIndex); +end; + +{@@ ---------------------------------------------------------------------------- + Seeks a format item with the given properties and returns its list index, + or -1 if not found. + + @param ANumFormat Built-in format identifier + @param AFormatString String of formatting codes + @return Index of the format item in the format list, + or -1 if not found. +-------------------------------------------------------------------------------} +function TsCustomNumFormatList.Find(ANumFormat: TsNumberFormat; + AFormatString: String): Integer; +var + item: TsNumFormatData; +begin + for Result := Count-1 downto 0 do + begin + item := Items[Result]; + if (item <> nil) and (item.NumFormat = ANumFormat) and (item.FormatString = AFormatString) + then exit; + end; + Result := -1; +end; + +{@@ ---------------------------------------------------------------------------- + Finds the item with the given format string and returns its index in the + format list, or -1 if not found. + + @param AFormatString string of formatting codes to be searched in the list. + @return Index of the format item in the format list, or -1 if not found. +-------------------------------------------------------------------------------} +function TsCustomNumFormatList.FindByFormatStr(AFormatString: String): integer; +var + item: TsNumFormatData; +begin + { We search backwards to find user-defined items first. They usually are + more appropriate than built-in items. } + for Result := Count-1 downto 0 do + begin + item := Items[Result]; + if item.FormatString = AFormatString then + exit; + end; + Result := -1; +end; + +{@@ ---------------------------------------------------------------------------- + Finds the item with the given Excel format index and returns its index in + the format list, or -1 if not found. + Is used by BIFF file formats. + + @param AFormatIndex Excel format index to the searched + @return Index of the format item in the format list, or -1 if not found. +-------------------------------------------------------------------------------} +function TsCustomNumFormatList.FindByIndex(AFormatIndex: Integer): integer; +var + item: TsNumFormatData; +begin + for Result := 0 to Count-1 do + begin + item := Items[Result]; + if item.Index = AFormatIndex then + exit; + end; + Result := -1; +end; + +{@@ ---------------------------------------------------------------------------- + Finds the item with the given ODS format name and returns its index in + the format list (or -1, if not found) + To be used by OpenDocument file format. + + @param AFormatName Format name as used by OpenDocument to identify a + number format + + @return Index of the format item in the list, or -1 if not found +-------------------------------------------------------------------------------} +function TsCustomNumFormatList.FindByName(AFormatName: String): integer; +var + item: TsNumFormatData; +begin + for Result := 0 to Count-1 do + begin + item := Items[Result]; + if item.Name = AFormatName then + exit; + end; + Result := -1; +end; + +{@@ ---------------------------------------------------------------------------- + Determines the format string to be written into the spreadsheet file. Calls + ConvertBeforeWriting in order to convert the fpc format strings to the dialect + used in the file. + + @param AIndex Index of the format item under consideration. + @return String of formatting codes that will be written to the file. +-------------------------------------------------------------------------------} +function TsCustomNumFormatList.FormatStringForWriting(AIndex: Integer): String; +var + item: TsNumFormatdata; + nf: TsNumberFormat; +begin + item := Items[AIndex]; + if item <> nil then + begin + Result := item.FormatString; + nf := item.NumFormat; + ConvertBeforeWriting(Result, nf); + end else + Result := ''; +end; + +function TsCustomNumFormatList.GetItem(AIndex: Integer): TsNumFormatData; +begin + Result := TsNumFormatData(inherited Items[AIndex]); +end; + +{@@ ---------------------------------------------------------------------------- + Deletes the memory occupied by the formatting data, but keeps an empty item in + the list to retain the indexes of following items. + + @param AIndex The number format item at this index will be removed. +-------------------------------------------------------------------------------} +procedure TsCustomNumFormatList.RemoveFormat(AIndex: Integer); +var + item: TsNumFormatData; +begin + item := GetItem(AIndex); + if item <> nil then + begin + item.Free; + SetItem(AIndex, nil); + end; +end; + +procedure TsCustomNumFormatList.SetItem(AIndex: Integer; AValue: TsNumFormatData); +begin + inherited Items[AIndex] := AValue; +end; + +function CompareNumFormatData(Item1, Item2: Pointer): Integer; +begin + Result := CompareValue(TsNumFormatData(Item1).Index, TsNumFormatData(Item2).Index); +end; + +{@@ ---------------------------------------------------------------------------- + Sorts the format data items in ascending order of the Excel format indexes. +-------------------------------------------------------------------------------} +procedure TsCustomNumFormatList.Sort; +begin + inherited Sort(@CompareNumFormatData); +end; + + +end. diff --git a/components/fpspreadsheet/fpsnumformatparser.pas b/components/fpspreadsheet/fpsnumformatparser.pas index 38c365eb4..85791d608 100644 --- a/components/fpspreadsheet/fpsnumformatparser.pas +++ b/components/fpspreadsheet/fpsnumformatparser.pas @@ -151,98 +151,16 @@ type end; -function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean; -function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; overload; -function IsDateTimeFormat(AFormatStr: String): Boolean; overload; -function IsTimeFormat(AFormat: TsNumberFormat): Boolean; overload; -function IsTimeFormat(AFormatStr: String): Boolean; overload; - - implementation uses TypInfo, StrUtils, LazUTF8, fpsutils, fpsCurrency; -{@@ ---------------------------------------------------------------------------- - Checks whether the given number format code is for currency, - i.e. requires currency symbol. - - @param AFormat Built-in number format identifier to be checked - @return True if AFormat is nfCurrency or nfCurrencyRed, false otherwise. --------------------------------------------------------------------------------} -function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean; -begin - Result := AFormat in [nfCurrency, nfCurrencyRed]; -end; - -{@@ ---------------------------------------------------------------------------- - Checks whether the given number format code is for date/time values. - - @param AFormat Built-in number format identifier to be checked - @return True if AFormat is a date/time format (such as nfShortTime), - false otherwise --------------------------------------------------------------------------------} -function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; -begin - Result := AFormat in [{nfFmtDateTime, }nfShortDateTime, nfShortDate, nfLongDate, - nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, nfTimeInterval]; -end; - -{@@ ---------------------------------------------------------------------------- - Checks whether the given string with formatting codes is for date/time values. - - @param AFormatStr String with formatting codes to be checked. - @return True if AFormatStr is a date/time format string (such as 'hh:nn'), - false otherwise --------------------------------------------------------------------------------} -function IsDateTimeFormat(AFormatStr: string): Boolean; -var - parser: TsNumFormatParser; -begin - parser := TsNumFormatParser.Create(nil, AFormatStr); - try - Result := parser.IsDateTimeFormat; - finally - parser.Free; - end; -end; - -{@@ ---------------------------------------------------------------------------- - Checks whether the given built-in number format code is for time values. - - @param AFormat Built-in number format identifier to be checked - @return True if AFormat represents to a time-format, false otherwise --------------------------------------------------------------------------------} -function IsTimeFormat(AFormat: TsNumberFormat): boolean; -begin - Result := AFormat in [nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, - nfTimeInterval]; -end; - -{@@ ---------------------------------------------------------------------------- - Checks whether the given string with formatting codes is for time values. - - @param AFormatStr String with formatting codes to be checked - @return True if AFormatStr represents a time-format, false otherwise --------------------------------------------------------------------------------} -function IsTimeFormat(AFormatStr: String): Boolean; -var - parser: TsNumFormatParser; -begin - parser := TsNumFormatParser.Create(nil, AFormatStr); - try - Result := parser.IsTimeFormat; - finally - parser.Free; - end; -end; - - { TsNumFormatParser } -{ Creates a number format parser for analyzing a formatstring that has been read - from a spreadsheet file. +{@@ Creates a number format parser for analyzing a formatstring that has been + read from a spreadsheet file. In case of "red" number formats we also have to specify the number format because the format string might not contain the color information, and we extract it from the NumFormat in this case. } diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 4f2dcff77..d5dabf4f4 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -38,8 +38,8 @@ uses {$ELSE} fpszipper, {$ENDIF} - fpstypes, fpspreadsheet, - fpsutils, fpsNumFormatParser, fpsxmlcommon; + fpstypes, fpspreadsheet, fpsReaderWriter, + fpsutils, fpsNumFormat, fpsNumFormatParser, fpsxmlcommon; type TDateMode=( diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 6ae3d076e..236328eb2 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -29,8 +29,8 @@ type { Forward declarations } TsWorksheet = class; TsWorkbook = class; - TsCustomSpreadReader = class; - TsCustomSpreadWriter = class; + TsBasicSpreadReader = class; + TsBasicSpreadWriter = class; {@@ Pointer to a TCell record } PCell = ^TCell; @@ -657,7 +657,6 @@ type procedure PrepareBeforeReading; procedure PrepareBeforeSaving; procedure ReCalc; - procedure UpdateCaches; public {@@ A copy of SysUtil's DefaultFormatSettings (converted to UTF8) to provide @@ -673,8 +672,8 @@ type out SheetType: TsSpreadsheetFormat): Boolean; class function GetFormatFromFileName(const AFileName: TFileName; out SheetType: TsSpreadsheetFormat): Boolean; - function CreateSpreadReader(AFormat: TsSpreadsheetFormat): TsCustomSpreadReader; - function CreateSpreadWriter(AFormat: TsSpreadsheetFormat): TsCustomSpreadWriter; + function CreateSpreadReader(AFormat: TsSpreadsheetFormat): TsBasicSpreadReader; + function CreateSpreadWriter(AFormat: TsSpreadsheetFormat): TsBasicSpreadWriter; procedure ReadFromFile(AFileName: string; AFormat: TsSpreadsheetFormat); overload; procedure ReadFromFile(AFileName: string); overload; procedure ReadFromFileIgnoringExtension(AFileName: string); @@ -747,6 +746,9 @@ type ABigEndian: Boolean = false); function UsesColor(AColorIndex: TsColor): Boolean; + { Utilities } + procedure UpdateCaches; + { Error messages } procedure AddErrorMsg(const AMsg: String); overload; procedure AddErrorMsg(const AMsg: String; const Args: array of const); overload; @@ -794,238 +796,53 @@ type property OnReadCellData: TsWorkbookReadCellDataEvent read FOnReadCellData write FOnReadCellData; end; - {@@ Contents of a number format record } - TsNumFormatData = class - public - {@@ Excel refers to a number format by means of the format "index". } - Index: Integer; - {@@ OpenDocument refers to a number format by means of the format "name". } - Name: String; - {@@ Identifier of a built-in number format, see TsNumberFormat } - NumFormat: TsNumberFormat; - {@@ String of format codes, such as '#,##0.00', or 'hh:nn'. } - FormatString: string; - end; - - {@@ Specialized list for number format items } - TsCustomNumFormatList = class(TFPList) - private - function GetItem(AIndex: Integer): TsNumFormatData; - procedure SetItem(AIndex: Integer; AValue: TsNumFormatData); + { TsBasicSpreadReaderWriter } + TsBasicSpreadReaderWriter = class protected - {@@ Workbook from which the number formats are collected in the list. It is - mainly needed to get access to the FormatSettings for easy localization of some - formatting strings. } + {@@ Instance of the workbook which is currently being read or written. } FWorkbook: TsWorkbook; - {@@ Identifies the first number format item that is written to the file. Items - having a smaller index are not written. } - FFirstNumFormatIndexInFile: Integer; - {@@ Identifies the index of the next Excel number format item to be written. - Needed for auto-creating of the user-defined Excel number format indexes } - FNextNumFormatIndex: Integer; - procedure AddBuiltinFormats; virtual; - procedure RemoveFormat(AIndex: Integer); - - public - constructor Create(AWorkbook: TsWorkbook); - destructor Destroy; override; - function AddFormat(AFormatIndex: Integer; AFormatName: String; - ANumFormat: TsNumberFormat; AFormatString: String): Integer; overload; - function AddFormat(AFormatIndex: Integer; ANumFormat: TsNumberFormat; - AFormatString: String): Integer; overload; - function AddFormat(AFormatName: String; ANumFormat: TsNumberFormat; - AFormatString: String): Integer; overload; - function AddFormat(ANumFormat: TsNumberFormat; AFormatString: String): Integer; overload; - procedure AnalyzeAndAdd(AFormatIndex: Integer; AFormatString: String); - procedure Clear; - procedure ConvertAfterReading(AFormatIndex: Integer; var AFormatString: String; - var ANumFormat: TsNumberFormat); virtual; - procedure ConvertBeforeWriting(var AFormatString: String; - var ANumFormat: TsNumberFormat); virtual; - procedure Delete(AIndex: Integer); - function Find(ANumFormat: TsNumberFormat; AFormatString: String): Integer; virtual; - function FindByFormatStr(AFormatString: String): Integer; - function FindByIndex(AFormatIndex: Integer): Integer; - function FindByName(AFormatName: String): Integer; - function FormatStringForWriting(AIndex: Integer): String; virtual; - procedure Sort; - - {@@ Workbook from which the number formats are collected in the list. It is - mainly needed to get access to the FormatSettings for easy localization of some - formatting strings. } - property Workbook: TsWorkbook read FWorkbook; - {@@ Identifies the first number format item that is written to the file. Items - having a smaller index are not written. } - property FirstNumFormatIndexInFile: Integer read FFirstNumFormatIndexInFile; - {@@ Number format items contained in the list } - property Items[AIndex: Integer]: TsNumFormatData read GetItem write SetItem; default; - end; - - - { TsCustomSpreadReaderWriter } - - {@@ Common ancestor of the spreadsheet reader and writer classes providing - shared data and methods. } - TsCustomSpreadReaderWriter = class - protected - {@@ Instance of the workbook which is currently being read. } - FWorkbook: TsWorkbook; - {@@ Instance of the worksheet which is currently being read. } + {@@ Instance of the worksheet which is currently being read or written. } FWorksheet: TsWorksheet; {@@ Limitations for the specific data file format } FLimitations: TsSpreadsheetFormatLimitations; - protected - {@@ List of number formats found in the file } - FNumFormatList: TsCustomNumFormatList; - procedure CreateNumFormatList; virtual; public - constructor Create(AWorkbook: TsWorkbook); virtual; // to allow descendents to override it - destructor Destroy; override; + constructor Create(AWorkbook: TsWorkbook); virtual; // to allow descendents to override it function Limitations: TsSpreadsheetFormatLimitations; {@@ Instance of the workbook which is currently being read/written. } property Workbook: TsWorkbook read FWorkbook; - {@@ List of number formats found in the workbook. } - property NumFormatList: TsCustomNumFormatList read FNumFormatList; end; - { TsCustomSpreadReader } + { TsBasicSpreadReader } + TsBasicSpreadReader = class(TsBasicSpreadReaderWriter) + public + { General writing methods } + procedure ReadFromFile(AFileName: string); virtual; abstract; + procedure ReadFromStream(AStream: TStream); virtual; abstract; + procedure ReadFromStrings(AStrings: TStrings); virtual; abstract; + end; + + { TsBasicSpreadWriter } + TsBasicSpreadWriter = class(TsBasicSpreadReaderWriter) + public + { Helpers } + procedure CheckLimitations; virtual; + { General writing methods } + procedure WriteToFile(const AFileName: string; + const AOverwriteExisting: Boolean = False); virtual; abstract; + procedure WriteToStream(AStream: TStream); virtual; abstract; + procedure WriteToStrings(AStrings: TStrings); virtual; abstract; + end; {@@ TsSpreadReader class reference type } - TsSpreadReaderClass = class of TsCustomSpreadReader; - - {@@ - Custom reader of spreadsheet files. "Custom" means that it provides only - the basic functionality. The main implementation is done in derived classes - for each individual file format. - } - TsCustomSpreadReader = class(TsCustomSpreadReaderWriter) - protected - {@@ list of format records collected from the file } - FCellFormatList: TsCellFormatList; - {@@ Temporary cell for virtual mode} - FVirtualCell: TCell; - {@@ Stores if the reader is in virtual mode } - FIsVirtualMode: Boolean; - - { Helper methods } - {@@ Removes column records if all of them have the same column width } - procedure FixCols(AWorksheet: TsWorksheet); - {@@ Removes row records if all of them have the same row height } - procedure FixRows(AWorksheet: TsWorksheet); - - { Record reading methods } - {@@ Abstract method for reading a blank cell. Must be overridden by descendent classes. } - procedure ReadBlank(AStream: TStream); virtual; abstract; - {@@ Abstract method for reading a BOOLEAN cell. Must be overridden by descendent classes. } - procedure ReadBool(AStream: TSTream); virtual; abstract; - {@@ Abstract method for reading a formula cell. Must be overridden by descendent classes. } - procedure ReadFormula(AStream: TStream); virtual; abstract; - {@@ Abstract method for reading a text cell. Must be overridden by descendent classes. } - procedure ReadLabel(AStream: TStream); virtual; abstract; - {@@ Abstract method for reading a number cell. Must be overridden by descendent classes. } - procedure ReadNumber(AStream: TStream); virtual; abstract; - public - constructor Create(AWorkbook: TsWorkbook); override; - destructor Destroy; override; - { General writing methods } - procedure ReadFromFile(AFileName: string); virtual; - procedure ReadFromStream(AStream: TStream); virtual; - procedure ReadFromStrings(AStrings: TStrings); virtual; - end; - - - { TsCustomSpreadWriter } + TsSpreadReaderClass = class of TsBasicSpreadReader; {@@ TsSpreadWriter class reference type } - TsSpreadWriterClass = class of TsCustomSpreadWriter; + TsSpreadWriterClass = class of TsBasicSpreadWriter; - {@@ Callback function when iterating cells while accessing a stream } - TCellsCallback = procedure (ACell: PCell; AStream: TStream) of object; - - {@@ Callback function when iterating comments while accessing a stream } - TCommentsCallback = procedure (AComment: PsComment; ACommentIndex: Integer; - AStream: TStream) of object; - - {@@ Custom writer of spreadsheet files. "Custom" means that it provides only - the basic functionality. The main implementation is done in derived classes - for each individual file format. } - TsCustomSpreadWriter = class(TsCustomSpreadReaderWriter) - protected - { Helper routines } - procedure CheckLimitations; - function FixColor(AColor: TsColor): TsColor; virtual; - procedure FixFormat(ACell: PCell); virtual; - procedure GetSheetDimensions(AWorksheet: TsWorksheet; - out AFirstRow, ALastRow, AFirstCol, ALastCol: Cardinal); virtual; - procedure ListAllNumFormats; virtual; - { Helpers for writing } - procedure WriteCellCallback(ACell: PCell; AStream: TStream); - procedure WriteCellsToStream(AStream: TStream; ACells: TAVLTree); - { Record writing methods } - {@@ Abstract method for writing a blank cell. Must be overridden by descendent classes. } - procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; - ACell: PCell); virtual; abstract; - {@@ Abstract method for writing a boolean cell. Must be overridden by descendent classes. } - procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal; - const AValue: Boolean; ACell: PCell); virtual; abstract; - {@@ (Pseudo-)abstract method for writing a cell comment. - Must be overridden by descendent classes } - procedure WriteComment(AStream: TStream; ACell: PCell); virtual; - {@@ Abstract method for writing a date/time value to a cell. - Must be overridden by descendent classes. } - procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; - const AValue: TDateTime; ACell: PCell); virtual; abstract; - {@@ Abstract method for writing an Excel error value to a cell. - Must be overridden by descendent classes. } - procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal; - const AValue: TsErrorValue; ACell: PCell); virtual; abstract; - {@@ (Pseudo-) abstract method for writing a formula to a cell. - Must be overridden by descendent classes. } - procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; - ACell: PCell); virtual; - {@@ (Pseudo-)abstract method for writing a hyperlink to a cell. - Must be overridden by descendent classes. } - procedure WriteHyperlink(AStream: TStream; const ARow, ACol: Cardinal; - ACell: PCell); virtual; - {@@ Abstract method for writing a string to a cell. - Must be overridden by descendent classes. } - procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; - const AValue: string; ACell: PCell); virtual; abstract; - {@@ Abstract method for writing a number value to a cell. - Must be overridden by descendent classes. } - procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; - const AValue: double; ACell: PCell); virtual; abstract; - - public - constructor Create(AWorkbook: TsWorkbook); override; - { General writing methods } - procedure IterateThroughCells(AStream: TStream; ACells: TAVLTree; - ACallback: TCellsCallback); - procedure IterateThroughComments(AStream: TStream; AComments: TAVLTree; - ACallback: TCommentsCallback); - procedure WriteToFile(const AFileName: string; - const AOverwriteExisting: Boolean = False); virtual; - procedure WriteToStream(AStream: TStream); virtual; - procedure WriteToStrings(AStrings: TStrings); virtual; - end; - - {@@ List of registered formats } - TsSpreadFormatData = record - ReaderClass: TsSpreadReaderClass; - WriterClass: TsSpreadWriterClass; - Format: TsSpreadsheetFormat; - end; - -var - GsSpreadFormats: array of TsSpreadFormatData; - -procedure RegisterSpreadFormat(AReaderClass: TsSpreadReaderClass; - AWriterClass: TsSpreadWriterClass; AFormat: TsSpreadsheetFormat); procedure CopyCellFormat(AFromCell, AToCell: PCell); procedure CopyCellValue(AFromCell, AToCell: PCell); -function GetFileFormatName(AFormat: TsSpreadsheetFormat): String; procedure MakeLEPalette(APalette: PsPalette; APaletteSize: Integer); //function SameCellBorders(ACell1, ACell2: PCell): Boolean; overload; function SameCellBorders(AFormat1, AFormat2: PsCellFormat): Boolean; //overload; @@ -1044,7 +861,8 @@ implementation uses Math, StrUtils, TypInfo, lazutf8, fpsPatches, fpsStrings, fpsStreams, uvirtuallayer_ole, - fpsUtils, fpsCurrency, fpsNumFormatParser, fpsExprParser; + fpsUtils, fpsreaderwriter, fpsCurrency, fpsExprParser, + fpsNumFormat, fpsNumFormatParser; const { These are reserved system colors by Microsoft @@ -1134,51 +952,6 @@ var 'wheat' // $16 ); -{@@ ---------------------------------------------------------------------------- - Registers a new reader/writer pair for a given spreadsheet file format --------------------------------------------------------------------------------} -procedure RegisterSpreadFormat( - AReaderClass: TsSpreadReaderClass; - AWriterClass: TsSpreadWriterClass; - AFormat: TsSpreadsheetFormat); -var - len: Integer; -begin - len := Length(GsSpreadFormats); - SetLength(GsSpreadFormats, len + 1); - - GsSpreadFormats[len].ReaderClass := AReaderClass; - GsSpreadFormats[len].WriterClass := AWriterClass; - GsSpreadFormats[len].Format := AFormat; -end; - -{@@ ---------------------------------------------------------------------------- - Returns the name of the given spreadsheet file format. - - @param AFormat Identifier of the file format - @return 'BIFF2', 'BIFF3', 'BIFF4', 'BIFF5', 'BIFF8', 'OOXML', 'Open Document', - 'CSV, 'WikiTable Pipes', or 'WikiTable WikiMedia" --------------------------------------------------------------------------------} -function GetFileFormatName(AFormat: TsSpreadsheetFormat): string; -begin - case AFormat of - sfExcel2 : Result := 'BIFF2'; - { - sfExcel3 : Result := 'BIFF3'; - sfExcel4 : Result := 'BIFF4'; - } - sfExcel5 : Result := 'BIFF5'; - sfExcel8 : Result := 'BIFF8'; - sfooxml : Result := 'OOXML'; - sfOpenDocument : Result := 'Open Document'; - sfCSV : Result := 'CSV'; - sfWikiTable_Pipes : Result := 'WikiTable Pipes'; - sfWikiTable_WikiMedia : Result := 'WikiTable WikiMedia'; - else Result := rsUnknownSpreadsheetFormat; - end; -end; - - {@@ ---------------------------------------------------------------------------- If a palette is coded as big-endian (e.g. by copying the rgb values from the OpenOffice documentation) the palette values can be converted by means @@ -7403,7 +7176,7 @@ end; @return An instance of a TsCustomSpreadReader descendent which is able to read the given file format. -------------------------------------------------------------------------------} -function TsWorkbook.CreateSpreadReader(AFormat: TsSpreadsheetFormat): TsCustomSpreadReader; +function TsWorkbook.CreateSpreadReader(AFormat: TsSpreadsheetFormat): TsBasicSpreadReader; var i: Integer; begin @@ -7429,7 +7202,7 @@ end; @return An instance of a TsCustomSpreadWriter descendent which is able to write the given file format. -------------------------------------------------------------------------------} -function TsWorkbook.CreateSpreadWriter(AFormat: TsSpreadsheetFormat): TsCustomSpreadWriter; +function TsWorkbook.CreateSpreadWriter(AFormat: TsSpreadsheetFormat): TsBasicSpreadWriter; var i: Integer; begin @@ -7499,7 +7272,7 @@ end; procedure TsWorkbook.ReadFromFile(AFileName: string; AFormat: TsSpreadsheetFormat); var - AReader: TsCustomSpreadReader; + AReader: TsBasicSpreadReader; ok: Boolean; begin if not FileExists(AFileName) then @@ -7618,7 +7391,7 @@ end; procedure TsWorkbook.ReadFromStream(AStream: TStream; AFormat: TsSpreadsheetFormat); var - AReader: TsCustomSpreadReader; + AReader: TsBasicSpreadReader; ok: Boolean; begin AReader := CreateSpreadReader(AFormat); @@ -7666,7 +7439,7 @@ end; procedure TsWorkbook.WriteToFile(const AFileName: string; const AFormat: TsSpreadsheetFormat; const AOverwriteExisting: Boolean = False); var - AWriter: TsCustomSpreadWriter; + AWriter: TsBasicSpreadWriter; begin AWriter := CreateSpreadWriter(AFormat); try @@ -7713,7 +7486,7 @@ end; -------------------------------------------------------------------------------} procedure TsWorkbook.WriteToStream(AStream: TStream; AFormat: TsSpreadsheetFormat); var - AWriter: TsCustomSpreadWriter; + AWriter: TsBasicSpreadWriter; begin AWriter := CreateSpreadWriter(AFormat); try @@ -8792,413 +8565,18 @@ end; {******************************************************************************* -* TsCustomNumFormatList * -*******************************************************************************} - -{@@ ---------------------------------------------------------------------------- - Constructor of the number format list. - - @param AWorkbook The workbook is needed to get access to its "FormatSettings" - for localization of some formatting strings. --------------------------------------------------------------------------------} -constructor TsCustomNumFormatList.Create(AWorkbook: TsWorkbook); -begin - inherited Create; - FWorkbook := AWorkbook; - AddBuiltinFormats; -end; - -{@@ ---------------------------------------------------------------------------- - Destructor of the number format list: clears the list and destroys the - format items --------------------------------------------------------------------------------} -destructor TsCustomNumFormatList.Destroy; -begin - Clear; - inherited Destroy; -end; - -{@@ ---------------------------------------------------------------------------- - Adds a number format described by the Excel format index, the ODF format - name, the format string, and the built-in format identifier to the list - and returns the index of the new item. - - @param AFormatIndex Format index to be used by Excel - @param AFormatName Format name to be used by OpenDocument - @param AFormatString String of formatting codes - @param ANumFormat Identifier for built-in number format - @return List index of the new item --------------------------------------------------------------------------------} -function TsCustomNumFormatList.AddFormat(AFormatIndex: Integer; - AFormatName: String; ANumFormat: TsNumberFormat; AFormatString: String): Integer; -var - item: TsNumFormatData; -begin - item := TsNumFormatData.Create; - item.Index := AFormatIndex; - item.Name := AFormatName; - item.NumFormat := ANumFormat; - item.FormatString := AFormatString; - Result := inherited Add(item); -end; - -{@@ ---------------------------------------------------------------------------- - Adds a number format described by the Excel format index, the format string, - and the built-in format identifier to the list and returns the index of - the new item in the format list. To be used when writing an Excel file. - - @param AFormatIndex Format index to be used by Excel - @param ANumFormat Identifier for built-in number format - @param AFormatString String of formatting codes - @return Index of the new item in the format list --------------------------------------------------------------------------------} -function TsCustomNumFormatList.AddFormat(AFormatIndex: Integer; - ANumFormat: TsNumberFormat; AFormatString: String): integer; -begin - Result := AddFormat(AFormatIndex, '', ANumFormat, AFormatString); -end; - -{@@ ---------------------------------------------------------------------------- - Adds a number format described by the ODF format name, the format string, - and the built-in format identifier to the list and returns the index of - the new item in the format list. To be used when writing an ODS file. - - @param AFormatName Format name to be used by OpenDocument - @param AFormatString String of formatting codes - @param ANumFormat Identifier for built-in number format - @return Index of the new item in the format list --------------------------------------------------------------------------------} -function TsCustomNumFormatList.AddFormat(AFormatName: String; - ANumFormat: TsNumberFormat; AFormatString: String): Integer; -begin - if (AFormatString = '') and (ANumFormat <> nfGeneral) then - begin - Result := 0; - exit; - end; - Result := AddFormat(FNextNumFormatIndex, AFormatName, ANumFormat, AFormatString); - inc(FNextNumFormatIndex); -end; - -{@@ ---------------------------------------------------------------------------- - Adds a number format described by the format string, and the built-in - format identifier to the format list and returns the index of the new - item in the list. The Excel format index and ODS format name are auto-generated. - - @param ANumFormat Identifier for built-in number format - @param AFormatString String of formatting codes - @return Index of the new item in the list --------------------------------------------------------------------------------} -function TsCustomNumFormatList.AddFormat(ANumFormat: TsNumberFormat; - AFormatString: String): Integer; -begin - Result := AddFormat('', ANumFormat, AFormatString); -end; - -{@@ ---------------------------------------------------------------------------- - Adds the builtin format items to the list. The formats must be specified in - a way that is compatible with fpc syntax. - - Conversion of the formatstrings to the syntax used in the destination file - can be done by calling "ConvertAfterReadung" bzw. "ConvertBeforeWriting". - "AddBuiltInFormats" must be called before user items are added. - - Must specify FFirstNumFormatIndexInFile (BIFF5-8, e.g. don't save formats <164) - and must initialize the index of the first user format (FNextNumFormatIndex) - which is automatically incremented when adding user formats. - - In TsCustomNumFormatList nothing is added. --------------------------------------------------------------------------------} -procedure TsCustomNumFormatList.AddBuiltinFormats; -begin - // must be overridden - see xlscommon as an example. -end; - -{@@ ---------------------------------------------------------------------------- - Called from the reader when a format item has been read from an Excel file. - Determines the number format type, format string etc and converts the - format string to fpc syntax which is used directly for getting the cell text. - - @param AFormatIndex Excel index of the number format read from the file - @param AFormatString String of formatting codes as read fromt the file. --------------------------------------------------------------------------------} -procedure TsCustomNumFormatList.AnalyzeAndAdd(AFormatIndex: Integer; - AFormatString: String); -var - nf: TsNumberFormat = nfGeneral; -begin - if FindByIndex(AFormatIndex) > -1 then - exit; - - // Analyze & convert the format string, extract infos for internal formatting - ConvertAfterReading(AFormatIndex, AFormatString, nf); - - // Add the new item - AddFormat(AFormatIndex, nf, AFormatString); -end; - -{@@ ---------------------------------------------------------------------------- - Clears the number format list and frees memory occupied by the format items. --------------------------------------------------------------------------------} -procedure TsCustomNumFormatList.Clear; -var - i: Integer; -begin - for i:=0 to Count-1 do RemoveFormat(i); - inherited Clear; -end; - -{@@ ---------------------------------------------------------------------------- - Takes the format string as it is read from the file and extracts the - built-in number format identifier out of it for use by fpc. - The method also converts the format string to a form that can be used - by fpc's FormatDateTime and FormatFloat. - - The method should be overridden in a class that knows knows more about the - details of the spreadsheet file format. - - @param AFormatIndex Excel index of the number format read - @param AFormatString string of formatting codes extracted from the file data - @param ANumFormat identifier for built-in fpspreadsheet format extracted - from the file data --------------------------------------------------------------------------------} -procedure TsCustomNumFormatList.ConvertAfterReading(AFormatIndex: Integer; - var AFormatString: String; var ANumFormat: TsNumberFormat); -var - parser: TsNumFormatParser; - fmt: String; - lFormatData: TsNumFormatData; - i: Integer; -begin - i := FindByIndex(AFormatIndex); - if i > 0 then - begin - lFormatData := Items[i]; - fmt := lFormatData.FormatString; - end else - fmt := AFormatString; - - // Analyzes the format string and tries to convert it to fpSpreadsheet format. - parser := TsNumFormatParser.Create(Workbook, fmt); - try - if parser.Status = psOK then - begin - ANumFormat := parser.NumFormat; - AFormatString := parser.FormatString[nfdDefault]; - end else - begin - // Show an error here? - end; - finally - parser.Free; - end; -end; - -{@@ ---------------------------------------------------------------------------- - Is called before collecting all number formats of the spreadsheet and before - writing them to file. Its purpose is to convert the format string as used by fpc - to a format compatible with the spreadsheet file format. - Nothing is changed in the TsCustomNumFormatList, the method needs to be - overridden by a descendant class which known more about the details of the - destination file format. - - Needs to be overridden by a class knowing more about the destination file - format. - - @param AFormatString String of formatting codes. On input in fpc syntax. Is - overwritten on output by format string compatible with - the destination file. - @param ANumFormat Identifier for built-in fpspreadsheet number format --------------------------------------------------------------------------------} -procedure TsCustomNumFormatList.ConvertBeforeWriting(var AFormatString: String; - var ANumFormat: TsNumberFormat); -begin - Unused(AFormatString, ANumFormat); - // nothing to do here. But see, e.g., xlscommon.TsBIFFNumFormatList -end; - - -{@@ ---------------------------------------------------------------------------- - Deletes a format item from the list, and makes sure that its memory is - released. - - @param AIndex List index of the item to be deleted. --------------------------------------------------------------------------------} -procedure TsCustomNumFormatList.Delete(AIndex: Integer); -begin - RemoveFormat(AIndex); - Delete(AIndex); -end; - -{@@ ---------------------------------------------------------------------------- - Seeks a format item with the given properties and returns its list index, - or -1 if not found. - - @param ANumFormat Built-in format identifier - @param AFormatString String of formatting codes - @return Index of the format item in the format list, - or -1 if not found. --------------------------------------------------------------------------------} -function TsCustomNumFormatList.Find(ANumFormat: TsNumberFormat; - AFormatString: String): Integer; -var - item: TsNumFormatData; -begin - for Result := Count-1 downto 0 do - begin - item := Items[Result]; - if (item <> nil) and (item.NumFormat = ANumFormat) and (item.FormatString = AFormatString) - then exit; - end; - Result := -1; -end; - -{@@ ---------------------------------------------------------------------------- - Finds the item with the given format string and returns its index in the - format list, or -1 if not found. - - @param AFormatString string of formatting codes to be searched in the list. - @return Index of the format item in the format list, or -1 if not found. --------------------------------------------------------------------------------} -function TsCustomNumFormatList.FindByFormatStr(AFormatString: String): integer; -var - item: TsNumFormatData; -begin - { We search backwards to find user-defined items first. They usually are - more appropriate than built-in items. } - for Result := Count-1 downto 0 do - begin - item := Items[Result]; - if item.FormatString = AFormatString then - exit; - end; - Result := -1; -end; - -{@@ ---------------------------------------------------------------------------- - Finds the item with the given Excel format index and returns its index in - the format list, or -1 if not found. - Is used by BIFF file formats. - - @param AFormatIndex Excel format index to the searched - @return Index of the format item in the format list, or -1 if not found. --------------------------------------------------------------------------------} -function TsCustomNumFormatList.FindByIndex(AFormatIndex: Integer): integer; -var - item: TsNumFormatData; -begin - for Result := 0 to Count-1 do - begin - item := Items[Result]; - if item.Index = AFormatIndex then - exit; - end; - Result := -1; -end; - -{@@ ---------------------------------------------------------------------------- - Finds the item with the given ODS format name and returns its index in - the format list (or -1, if not found) - To be used by OpenDocument file format. - - @param AFormatName Format name as used by OpenDocument to identify a - number format - - @return Index of the format item in the list, or -1 if not found --------------------------------------------------------------------------------} -function TsCustomNumFormatList.FindByName(AFormatName: String): integer; -var - item: TsNumFormatData; -begin - for Result := 0 to Count-1 do - begin - item := Items[Result]; - if item.Name = AFormatName then - exit; - end; - Result := -1; -end; - -{@@ ---------------------------------------------------------------------------- - Determines the format string to be written into the spreadsheet file. Calls - ConvertBeforeWriting in order to convert the fpc format strings to the dialect - used in the file. - - @param AIndex Index of the format item under consideration. - @return String of formatting codes that will be written to the file. --------------------------------------------------------------------------------} -function TsCustomNumFormatList.FormatStringForWriting(AIndex: Integer): String; -var - item: TsNumFormatdata; - nf: TsNumberFormat; -begin - item := Items[AIndex]; - if item <> nil then - begin - Result := item.FormatString; - nf := item.NumFormat; - ConvertBeforeWriting(Result, nf); - end else - Result := ''; -end; - -function TsCustomNumFormatList.GetItem(AIndex: Integer): TsNumFormatData; -begin - Result := TsNumFormatData(inherited Items[AIndex]); -end; - -{@@ ---------------------------------------------------------------------------- - Deletes the memory occupied by the formatting data, but keeps an empty item in - the list to retain the indexes of following items. - - @param AIndex The number format item at this index will be removed. --------------------------------------------------------------------------------} -procedure TsCustomNumFormatList.RemoveFormat(AIndex: Integer); -var - item: TsNumFormatData; -begin - item := GetItem(AIndex); - if item <> nil then - begin - item.Free; - SetItem(AIndex, nil); - end; -end; - -procedure TsCustomNumFormatList.SetItem(AIndex: Integer; AValue: TsNumFormatData); -begin - inherited Items[AIndex] := AValue; -end; - -function CompareNumFormatData(Item1, Item2: Pointer): Integer; -begin - Result := CompareValue(TsNumFormatData(Item1).Index, TsNumFormatData(Item2).Index); -end; - -{@@ ---------------------------------------------------------------------------- - Sorts the format data items in ascending order of the Excel format indexes. --------------------------------------------------------------------------------} -procedure TsCustomNumFormatList.Sort; -begin - inherited Sort(@CompareNumFormatData); -end; - - -{******************************************************************************* -* TsCustomSpreadReaderWriter * +* TsBasicSpreadReaderWriter * *******************************************************************************} {@@ ---------------------------------------------------------------------------- Constructor of the reader/writer. Has the workbook to be read/written as a parameter to apply the localization information found in its FormatSettings. - Creates an internal instance of the number format list according to the - file format being read/written. @param AWorkbook Workbook into which the file is being read or from with the file is written. This parameter is passed from the workbook which creates the reader/writer. -------------------------------------------------------------------------------} -constructor TsCustomSpreadReaderWriter.Create(AWorkbook: TsWorkbook); +constructor TsBasicSpreadReaderWriter.Create(AWorkbook: TsWorkbook); begin inherited Create; FWorkbook := AWorkbook; @@ -9206,289 +8584,26 @@ begin FLimitations.MaxColCount := 256; FLimitations.MaxRowCount := 65536; FLimitations.MaxPaletteSize := MaxInt; - // Number formats - CreateNumFormatList; -end; - -{@@ ---------------------------------------------------------------------------- - Destructor of the reader. Destroys the internal number format list and the - error log list. --------------------------------------------------------------------------------} -destructor TsCustomSpreadReaderWriter.Destroy; -begin - FNumFormatList.Free; - inherited Destroy; -end; - -{@@ ---------------------------------------------------------------------------- - Creates an instance of the number format list which contains prototypes of - all number formats found in the workbook (when writing) or in the file (when - reading). - - The method has to be overridden because the descendants know the special - requirements of the file format. --------------------------------------------------------------------------------} -procedure TsCustomSpreadReaderWriter.CreateNumFormatList; -begin - // nothing to do here end; {@@ ---------------------------------------------------------------------------- Returns a record containing limitations of the specific file format of the writer. -------------------------------------------------------------------------------} -function TsCustomSpreadReaderWriter.Limitations: TsSpreadsheetFormatLimitations; +function TsBasicSpreadReaderWriter.Limitations: TsSpreadsheetFormatLimitations; begin Result := FLimitations; end; {******************************************************************************* -* TsCustomSpreadReader * +* TsBasicSpreadWriter * *******************************************************************************} -{@@ ---------------------------------------------------------------------------- - Constructor of the reader. Has the workbook to be read as a parameter to - apply the localization information found in its FormatSettings. - Creates an internal instance of the number format list according to the - file format being read. - - @param AWorkbook Workbook into which the file is being read. This parameter - is passed from the workbook which creates the reader. --------------------------------------------------------------------------------} -constructor TsCustomSpreadReader.Create(AWorkbook: TsWorkbook); -begin - inherited Create(AWorkbook); - FIsVirtualMode := (boVirtualMode in FWorkbook.Options) and - Assigned(FWorkbook.OnReadCellData); -end; - -{@@ ---------------------------------------------------------------------------- - Destructor of the reader. Overridden to destroy the format list. --------------------------------------------------------------------------------} -destructor TsCustomSpreadReader.Destroy; -begin - FreeAndNil(FCellFormatList); - inherited Destroy; -end; - -{@@ ---------------------------------------------------------------------------- - Deletes unnecessary column records as they are written by Office applications - when they convert a file to another format. - - @param AWorksheet The columns in this worksheet are processed. --------------------------------------------------------------------------------} -procedure TsCustomSpreadReader.FixCols(AWorkSheet: TsWorksheet); -const - EPS = 1E-3; -var - c: Cardinal; - w: Single; -begin - if AWorksheet.Cols.Count <= 1 then - exit; - - // Check whether all columns have the same column width - w := PCol(AWorksheet.Cols[0])^.Width; - for c := 1 to AWorksheet.Cols.Count-1 do - if not SameValue(PCol(AWorksheet.Cols[c])^.Width, w, EPS) then - exit; - - // At this point we know that all columns have the same width. We pass this - // to the DefaultColWidth and delete all column records. - AWorksheet.DefaultColWidth := w; - AWorksheet.RemoveAllCols; -end; - -{@@ ---------------------------------------------------------------------------- - This procedure checks whether all rows have the same height and removes the - row records if they do. Such unnecessary row records are often written - when an Office application converts a file to another format. --------------------------------------------------------------------------------} -procedure TsCustomSpreadReader.FixRows(AWorkSheet: TsWorksheet); -const - EPS = 1E-3; -var - r: Cardinal; - h: Single; -begin - if AWorksheet.Rows.Count <= 1 then - exit; - - // Check whether all rows have the same height - h := PRow(AWorksheet.Rows[0])^.Height; - for r := 1 to AWorksheet.Rows.Count-1 do - if not SameValue(PRow(AWorksheet.Rows[r])^.Height, h, EPS) then - exit; - - // At this point we know that all rows have the same height. We pass this - // to the DefaultRowHeight and delete all row records. - AWorksheet.DefaultRowHeight := h; - AWorksheet.RemoveAllRows; -end; - -{@@ ---------------------------------------------------------------------------- - Default file reading method. - - Opens the file and calls ReadFromStream. Data are stored in the workbook - specified during construction. - - @param AFileName The input file name. - @see TsWorkbook --------------------------------------------------------------------------------} -procedure TsCustomSpreadReader.ReadFromFile(AFileName: string); -var - InputFile: TStream; -begin - if (boBufStream in Workbook.Options) then - InputFile := TBufStream.Create(AFileName, fmOpenRead + fmShareDenyNone) - else - InputFile := TFileStream.Create(AFileName, fmOpenRead + fmShareDenyNone); - - try - ReadFromStream(InputFile); - finally - InputFile.Free; - end; -end; - -{@@ ---------------------------------------------------------------------------- - This routine has the purpose to read the workbook data from the stream. - It should be overriden in descendent classes. - - Its basic implementation here assumes that the stream is a TStringStream and - the data are provided by calling ReadFromStrings. This mechanism is valid - for wikitables. - - Data will be stored in the workbook defined at construction. - - @param AData Workbook which is filled by the data from the stream. --------------------------------------------------------------------------------} -procedure TsCustomSpreadReader.ReadFromStream(AStream: TStream); -var - AStringStream: TStringStream; - AStrings: TStringList; -begin - AStringStream := TStringStream.Create(''); - AStrings := TStringList.Create; - try - AStringStream.CopyFrom(AStream, AStream.Size); - AStringStream.Seek(0, soFromBeginning); - AStrings.Text := AStringStream.DataString; - ReadFromStrings(AStrings); - finally - AStringStream.Free; - AStrings.Free; - end; -end; - -{@@ ---------------------------------------------------------------------------- - Reads workbook data from a string list. This abstract implementation does - nothing and raises an exception. Must be overridden, like for wikitables. --------------------------------------------------------------------------------} -procedure TsCustomSpreadReader.ReadFromStrings(AStrings: TStrings); -begin - Unused(AStrings); - raise Exception.Create(rsUnsupportedReadFormat); -end; - - -{******************************************************************************* -* TsCustomSpreadWriter * -*******************************************************************************} - -{@@ ---------------------------------------------------------------------------- - Constructor of the writer. Has the workbook to be written as a parameter to - apply the localization information found in its FormatSettings. - Creates an internal number format list to collect unique samples of all the - number formats found in the workbook. - - @param AWorkbook Workbook which is to be written to file/stream. - This parameter is passed from the workbook which creates the - writer. --------------------------------------------------------------------------------} -constructor TsCustomSpreadWriter.Create(AWorkbook: TsWorkbook); -begin - inherited Create(AWorkbook); -end; - -{@@ ---------------------------------------------------------------------------- - If a color index is greater then the maximum palette color count this - color is replaced by the closest palette color. - - The present implementation does not change the color. Must be overridden by - writers of formats with limited palette sizes. - - @param AColor Color palette index to be checked - @return Closest color to AColor. If AColor belongs to the palette it must - be returned unchanged. --------------------------------------------------------------------------------} -function TsCustomSpreadWriter.FixColor(AColor: TsColor): TsColor; -begin - Result := AColor; -end; - -{@@ ---------------------------------------------------------------------------- - If formatting features of a cell are not supported by the destination file - format of the writer, here is the place to apply replacements. - Must be overridden by descendants, nothin happens here. See BIFF2. - - @param ACell Pointer to the cell being investigated. Note that this cell - does not belong to the workbook, but is a cell of the - FFormattingStyles array. --------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.FixFormat(ACell: PCell); -begin - Unused(ACell); - // to be overridden -end; - -{@@ ---------------------------------------------------------------------------- - Determines the size of the worksheet to be written. VirtualMode is respected. - Is called when the writer needs the size for output. Column and row count - limitations are repsected as well. - - @param AWorksheet Worksheet to be written - @param AFirsRow Index of first row to be written - @param ALastRow Index of last row - @param AFirstCol Index of first column to be written - @param ALastCol Index of last column to be written --------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.GetSheetDimensions(AWorksheet: TsWorksheet; - out AFirstRow, ALastRow, AFirstCol, ALastCol: Cardinal); -begin - if (boVirtualMode in AWorksheet.Workbook.Options) then - begin - AFirstRow := 0; - AFirstCol := 0; - ALastRow := AWorksheet.Workbook.VirtualRowCount-1; - ALastCol := AWorksheet.Workbook.VirtualColCount-1; - end else - begin - Workbook.UpdateCaches; - AFirstRow := AWorksheet.GetFirstRowIndex; - if AFirstRow = Cardinal(-1) then - AFirstRow := 0; // this happens if the sheet is empty and does not contain row records - AFirstCol := AWorksheet.GetFirstColIndex; - if AFirstCol = Cardinal(-1) then - AFirstCol := 0; // this happens if the sheet is empty and does not contain col records - ALastRow := AWorksheet.GetLastRowIndex; - ALastCol := AWorksheet.GetLastColIndex; - end; - if AFirstCol >= Limitations.MaxColCount then - AFirstCol := Limitations.MaxColCount-1; - if AFirstRow >= Limitations.MaxRowCount then - AFirstRow := Limitations.MaxRowCount-1; - if ALastCol >= Limitations.MaxColCount then - ALastCol := Limitations.MaxColCount-1; - if ALastRow >= Limitations.MaxRowCount then - ALastRow := Limitations.MaxRowCount-1; -end; - {@@ ---------------------------------------------------------------------------- Checks limitations of the writer, e.g max row/column count -------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.CheckLimitations; +procedure TsBasicSpreadWriter.CheckLimitations; var lastCol, lastRow: Cardinal; i, n: Integer; @@ -9514,226 +8629,6 @@ begin end; end; -{@@ ---------------------------------------------------------------------------- - Iterates through all cells and collects the number formats in - FNumFormatList (without duplicates). - The index of the list item is needed for the field FormatIndex of the XF record. - At the time when the method is called the formats are still in fpc dialect. --------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.ListAllNumFormats; -var - i: Integer; - fmt: PsCellFormat; -begin - for i:=0 to Workbook.GetNumCellFormats - 1 do - begin - fmt := Workbook.GetPointerToCellFormat(i); - if FNumFormatList.Find(fmt^.NumberFormat, fmt^.NumberFormatStr) = -1 then - FNumFormatList.AddFormat(fmt^.NumberFormat, fmt^.NumberFormatStr); - end; -end; - -{@@ ---------------------------------------------------------------------------- - Helper function for the spreadsheet writers. Writes the cell value to the - stream. Calls the WriteNumber method of the worksheet for writing a number, - the WriteDateTime method for writing a date/time etc. - - @param ACell Pointer to the worksheet cell being written - @param AStream Stream to which data are written - - @see TsCustomSpreadWriter.WriteCellsToStream --------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.WriteCellCallback(ACell: PCell; AStream: TStream); -begin - if HasFormula(ACell) then - WriteFormula(AStream, ACell^.Row, ACell^.Col, ACell) - else - 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); - cctHyperlink: - WriteHyperlink(AStream, ACell^.Row, ACell^.Col, ACell); - end; - //if ACell^.Comment <> '' then - if FWorksheet.ReadComment(ACell) <> '' then - WriteComment(AStream, ACell); -end; - -{@@ ---------------------------------------------------------------------------- - Helper function for the spreadsheet writers. - - Iterates all cells on a list, calling the appropriate write method for them. - - @param AStream The output stream. - @param ACells List of cells to be writeen --------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.WriteCellsToStream(AStream: TStream; - ACells: TAVLTree); -begin - IterateThroughCells(AStream, ACells, WriteCellCallback); -end; - -{@@ ---------------------------------------------------------------------------- - (Pseudo-) abstract method writing a cell comment to the stream. - The cell comment is written immediately after the cell content. - NOTE: This is not good for XLSX and BIFF8. - - Must be overridden by descendents. - - @param ACell Pointer to the cell containing the comment to be written --------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.WriteComment(AStream: TStream; ACell: PCell); -begin - Unused(AStream, ACell); -end; - -{@@ ---------------------------------------------------------------------------- - A generic method to iterate through all cells in a worksheet and call a callback - routine for each cell. - - @param AStream The output stream, passed to the callback routine. - @param ACells List of cells to be iterated - @param ACallback Callback routine; it requires as arguments a pointer to the - cell as well as the destination stream. --------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.IterateThroughCells(AStream: TStream; - ACells: TAVLTree; ACallback: TCellsCallback); -var - AVLNode: TAVLTreeNode; -begin - AVLNode := ACells.FindLowest; - while Assigned(AVLNode) do - begin - ACallback(PCell(AVLNode.Data), AStream); - AVLNode := ACells.FindSuccessor(AVLNode); - end; -end; - -{@@ ---------------------------------------------------------------------------- - A generic method to iterate through all comments in a worksheet and call a - callback routine for each cell. - - @param AStream The output stream, passed to the callback routine. - @param AComments List of comments to be iterated - @param ACallback Callback routine; it requires as arguments a pointer to the - comment record as well as the destination stream. --------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.IterateThroughComments(AStream: TStream; - AComments: TAVLTree; ACallback: TCommentsCallback); -var - AVLNode: TAVLTreeNode; - index: Integer; -begin - index := 0; - AVLNode := AComments.FindLowest; - while Assigned(AVLNode) do - begin - ACallback(PsComment(AVLNode.Data), index, AStream); - AVLNode := AComments.FindSuccessor(AVLNode); - inc(index); - end; -end; - -{@@ ---------------------------------------------------------------------------- - Default file writing method. - - Opens the file and calls WriteToStream - The workbook written is the one specified in the constructor of the writer. - - @param AFileName The output file name. - @param AOverwriteExisting If the file already exists it will be replaced. - - @see TsWorkbook --------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.WriteToFile(const AFileName: string; - const AOverwriteExisting: Boolean = False); -var - OutputFile: TStream; - lMode: Word; -begin - if AOverwriteExisting then - lMode := fmCreate or fmOpenWrite - else - lMode := fmCreate; - - if (boBufStream in Workbook.Options) then - OutputFile := TBufStream.Create(AFileName, lMode) - else - OutputFile := TFileStream.Create(AFileName, lMode); - - try - WriteToStream(OutputFile); - finally - OutputFile.Free; - end; -end; - -{@@ ---------------------------------------------------------------------------- - This routine has the purpose to write the workbook to a stream. - Present implementation writes to a stringlists by means of WriteToStrings; - this behavior is required for wikitables. - Must be overriden in descendent classes for all other cases. - - @param AStream Stream to which the workbook is written --------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.WriteToStream(AStream: TStream); -var - lStringList: TStringList; -begin - lStringList := TStringList.Create; - try - WriteToStrings(lStringList); - lStringList.SaveToStream(AStream); - finally - lStringList.Free; - end; -end; - -{@@ ---------------------------------------------------------------------------- - Writes the worksheet to a list of strings. Not implemented here, needs to - be overridden by descendants. See wikitables. --------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.WriteToStrings(AStrings: TStrings); -begin - Unused(AStrings); - raise Exception.Create(rsUnsupportedWriteFormat); -end; - -{@@ ---------------------------------------------------------------------------- - Basic method which is called when writing a formula to a stream. The formula - is already stored in the cell fields. - Present implementation does nothing. Needs to be overridden by descendants. - - @param AStream Stream to be written - @param ARow Row index of the cell containing the formula - @param ACol Column index of the cell containing the formula - @param ACell Pointer to the cell containing the formula and being written - to the stream --------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.WriteFormula(AStream: TStream; - const ARow, ACol: Cardinal; ACell: PCell); -begin - Unused(AStream); - Unused(ARow, ACol, ACell); -end; - -procedure TsCustomSpreadWriter.WriteHyperlink(AStream: TStream; - const ARow, ACol: Cardinal; ACell: PCell); -begin - Unused(AStream); - Unused(ARow, ACol, ACell); -end; - initialization // Default palette diff --git a/components/fpspreadsheet/fpsreaderwriter.pas b/components/fpspreadsheet/fpsreaderwriter.pas new file mode 100644 index 000000000..95329bd90 --- /dev/null +++ b/components/fpspreadsheet/fpsreaderwriter.pas @@ -0,0 +1,692 @@ +{ fpsReaderWriter } + +{@@ ---------------------------------------------------------------------------- + Unit fpsReaderWriter implements basic reading/writing support + for fpspreadsheet. + + AUTHORS: Felipe Monteiro de Carvalho, Reinier Olislagers, Werner Pamler + + LICENSE: See the file COPYING.modifiedLGPL.txt, included in the Lazarus + distribution, for details about the license. +-------------------------------------------------------------------------------} + +unit fpsReaderWriter; + +{$ifdef fpc} + {$mode delphi}{$H+} +{$endif} + +interface + +uses + Classes, Sysutils, AVL_Tree, + fpsTypes, fpSpreadsheet, fpsNumFormat; + +type + {@@ + Custom reader of spreadsheet files. "Custom" means that it provides only + the basic functionality. The main implementation is done in derived classes + for each individual file format. + } + TsCustomSpreadReader = class(TsBasicSpreadReader) + protected + {@@ list of format records collected from the file } + FCellFormatList: TsCellFormatList; + {@@ Temporary cell for virtual mode} + FVirtualCell: TCell; + {@@ Stores if the reader is in virtual mode } + FIsVirtualMode: Boolean; + {@@ List of number formats found in the file } + FNumFormatList: TsCustomNumFormatList; + + { Helper methods } + {@@ Removes column records if all of them have the same column width } + procedure FixCols(AWorksheet: TsWorksheet); + {@@ Removes row records if all of them have the same row height } + procedure FixRows(AWorksheet: TsWorksheet); + + { Record reading methods } + {@@ Abstract method for reading a blank cell. Must be overridden by descendent classes. } + procedure ReadBlank(AStream: TStream); virtual; abstract; + {@@ Abstract method for reading a BOOLEAN cell. Must be overridden by descendent classes. } + procedure ReadBool(AStream: TSTream); virtual; abstract; + {@@ Abstract method for reading a formula cell. Must be overridden by descendent classes. } + procedure ReadFormula(AStream: TStream); virtual; abstract; + {@@ Abstract method for reading a text cell. Must be overridden by descendent classes. } + procedure ReadLabel(AStream: TStream); virtual; abstract; + {@@ Abstract method for reading a number cell. Must be overridden by descendent classes. } + procedure ReadNumber(AStream: TStream); virtual; abstract; + + procedure CreateNumFormatList; virtual; + + public + constructor Create(AWorkbook: TsWorkbook); override; + destructor Destroy; override; + + { General writing methods } + procedure ReadFromFile(AFileName: string); override; + procedure ReadFromStream(AStream: TStream); override; + procedure ReadFromStrings(AStrings: TStrings); override; + + {@@ List of number formats found in the workbook. } + property NumFormatList: TsCustomNumFormatList read FNumFormatList; + end; + + + {@@ Callback function when iterating cells while accessing a stream } + TCellsCallback = procedure (ACell: PCell; AStream: TStream) of object; + + {@@ Callback function when iterating comments while accessing a stream } + TCommentsCallback = procedure (AComment: PsComment; ACommentIndex: Integer; + AStream: TStream) of object; + + {@@ Custom writer of spreadsheet files. "Custom" means that it provides only + the basic functionality. The main implementation is done in derived classes + for each individual file format. } + TsCustomSpreadWriter = class(TsBasicSpreadWriter) + protected + {@@ List of number formats found in the file } + FNumFormatList: TsCustomNumFormatList; + + procedure CreateNumFormatList; virtual; + function FixColor(AColor: TsColor): TsColor; virtual; + procedure FixFormat(ACell: PCell); virtual; + procedure GetSheetDimensions(AWorksheet: TsWorksheet; + out AFirstRow, ALastRow, AFirstCol, ALastCol: Cardinal); virtual; + procedure ListAllNumFormats; virtual; + + { Helpers for writing } + procedure WriteCellCallback(ACell: PCell; AStream: TStream); + procedure WriteCellsToStream(AStream: TStream; ACells: TAVLTree); + + { Record writing methods } + procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; + ACell: PCell); virtual; abstract; + procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal; + const AValue: Boolean; ACell: PCell); virtual; abstract; + procedure WriteComment(AStream: TStream; ACell: PCell); virtual; + procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; + const AValue: TDateTime; ACell: PCell); virtual; abstract; + procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal; + const AValue: TsErrorValue; ACell: PCell); virtual; abstract; + procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; + ACell: PCell); virtual; + procedure WriteHyperlink(AStream: TStream; const ARow, ACol: Cardinal; + ACell: PCell); virtual; + procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; + const AValue: string; ACell: PCell); virtual; abstract; + procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; + const AValue: double; ACell: PCell); virtual; abstract; + + public + constructor Create(AWorkbook: TsWorkbook); override; + destructor Destroy; override; + { General writing methods } + procedure IterateThroughCells(AStream: TStream; ACells: TAVLTree; + ACallback: TCellsCallback); + procedure IterateThroughComments(AStream: TStream; AComments: TAVLTree; + ACallback: TCommentsCallback); + procedure WriteToFile(const AFileName: string; + const AOverwriteExisting: Boolean = False); override; + procedure WriteToStream(AStream: TStream); override; + procedure WriteToStrings(AStrings: TStrings); override; + + {@@ List of number formats found in the workbook. } + property NumFormatList: TsCustomNumFormatList read FNumFormatList; + end; + + {@@ List of registered formats } + TsSpreadFormatData = record + ReaderClass: TsSpreadReaderClass; + WriterClass: TsSpreadWriterClass; + Format: TsSpreadsheetFormat; + end; + +var + GsSpreadFormats: array of TsSpreadFormatData; + +procedure RegisterSpreadFormat(AReaderClass: TsSpreadReaderClass; + AWriterClass: TsSpreadWriterClass; AFormat: TsSpreadsheetFormat); + + +implementation + +uses + Math, + fpsStrings, fpsUtils, fpsStreams; + +{@@ ---------------------------------------------------------------------------- + Registers a new reader/writer pair for a given spreadsheet file format +-------------------------------------------------------------------------------} +procedure RegisterSpreadFormat( + AReaderClass: TsSpreadReaderClass; + AWriterClass: TsSpreadWriterClass; + AFormat: TsSpreadsheetFormat); +var + len: Integer; +begin + len := Length(GsSpreadFormats); + SetLength(GsSpreadFormats, len + 1); + + GsSpreadFormats[len].ReaderClass := AReaderClass; + GsSpreadFormats[len].WriterClass := AWriterClass; + GsSpreadFormats[len].Format := AFormat; +end; + + +{******************************************************************************* +* TsCustomSpreadReader * +*******************************************************************************} + +{@@ ---------------------------------------------------------------------------- + Constructor of the reader. Has the workbook to be read as a + parameter to apply the localization information found in its FormatSettings. + Creates an internal instance of the number format list according to the + file format being read/written. + + @param AWorkbook Workbook into which the file is being read. + This parameter is passed from the workbook which creates + the reader. +-------------------------------------------------------------------------------} +constructor TsCustomSpreadReader.Create(AWorkbook: TsWorkbook); +begin + inherited Create(AWorkbook); + // Number formats + CreateNumFormatList; + // Virtual mode + FIsVirtualMode := (boVirtualMode in FWorkbook.Options) and + Assigned(FWorkbook.OnReadCellData); +end; + +{@@ ---------------------------------------------------------------------------- + Destructor of the reader. Destroys the internal number format list and the + error log list. +-------------------------------------------------------------------------------} +destructor TsCustomSpreadReader.Destroy; +begin + FreeAndNil(FNumFormatList); + inherited Destroy; +end; + +{@@ ---------------------------------------------------------------------------- + Creates an instance of the number format list which contains prototypes of + all number formats found in the the file (when reading). + + The method has to be overridden because the descendants know the special + requirements of the file format. +-------------------------------------------------------------------------------} +procedure TsCustomSpreadReader.CreateNumFormatList; +begin + // nothing to do here +end; + +{@@ ---------------------------------------------------------------------------- + Deletes unnecessary column records as they are written by some + Office applications when they convert a file to another format. + + @param AWorksheet The columns in this worksheet are processed. +-------------------------------------------------------------------------------} +procedure TsCustomSpreadReader.FixCols(AWorkSheet: TsWorksheet); +const + EPS = 1E-3; +var + c: Cardinal; + w: Single; +begin + if AWorksheet.Cols.Count <= 1 then + exit; + + // Check whether all columns have the same column width + w := PCol(AWorksheet.Cols[0])^.Width; + for c := 1 to AWorksheet.Cols.Count-1 do + if not SameValue(PCol(AWorksheet.Cols[c])^.Width, w, EPS) then + exit; + + // At this point we know that all columns have the same width. We pass this + // to the DefaultColWidth and delete all column records. + AWorksheet.DefaultColWidth := w; + AWorksheet.RemoveAllCols; +end; + +{@@ ---------------------------------------------------------------------------- + This procedure checks whether all rows have the same height and removes the + row records if they do. Such unnecessary row records are often written + when an Office application converts a file to another format. +-------------------------------------------------------------------------------} +procedure TsCustomSpreadReader.FixRows(AWorkSheet: TsWorksheet); +const + EPS = 1E-3; +var + r: Cardinal; + h: Single; +begin + if AWorksheet.Rows.Count <= 1 then + exit; + + // Check whether all rows have the same height + h := PRow(AWorksheet.Rows[0])^.Height; + for r := 1 to AWorksheet.Rows.Count-1 do + if not SameValue(PRow(AWorksheet.Rows[r])^.Height, h, EPS) then + exit; + + // At this point we know that all rows have the same height. We pass this + // to the DefaultRowHeight and delete all row records. + AWorksheet.DefaultRowHeight := h; + AWorksheet.RemoveAllRows; +end; + +{@@ ---------------------------------------------------------------------------- + Default file reading method. + + Opens the file and calls ReadFromStream. Data are stored in the workbook + specified during construction. + + @param AFileName The input file name. + @see TsWorkbook +-------------------------------------------------------------------------------} +procedure TsCustomSpreadReader.ReadFromFile(AFileName: string); +var + stream: TStream; +begin + if (boBufStream in Workbook.Options) then + stream := TBufStream.Create(AFileName, fmOpenRead + fmShareDenyNone) + else + stream := TFileStream.Create(AFileName, fmOpenRead + fmShareDenyNone); + + try + ReadFromStream(stream); + finally + stream.Free; + end; +end; + +{@@ ---------------------------------------------------------------------------- + This routine has the purpose to read the workbook data from the stream. + It should be overriden in descendent classes. + + Its basic implementation here assumes that the stream is a TStringStream and + the data are provided by calling ReadFromStrings. This mechanism is valid + for wikitables. + + Data will be stored in the workbook defined at construction. + + @param AData Workbook which is filled by the data from the stream. +-------------------------------------------------------------------------------} +procedure TsCustomSpreadReader.ReadFromStream(AStream: TStream); +var + AStringStream: TStringStream; + AStrings: TStringList; +begin + AStringStream := TStringStream.Create(''); + AStrings := TStringList.Create; + try + AStringStream.CopyFrom(AStream, AStream.Size); + AStringStream.Seek(0, soFromBeginning); + AStrings.Text := AStringStream.DataString; + ReadFromStrings(AStrings); + finally + AStringStream.Free; + AStrings.Free; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Reads workbook data from a string list. This abstract implementation does + nothing and raises an exception. Must be overridden, like for wikitables. +-------------------------------------------------------------------------------} +procedure TsCustomSpreadReader.ReadFromStrings(AStrings: TStrings); +begin + Unused(AStrings); + raise Exception.Create(rsUnsupportedReadFormat); +end; + + +{******************************************************************************* +* TsCustomSpreadWriter * +*******************************************************************************} + +{@@ ---------------------------------------------------------------------------- + Constructor of the writer. Has the workbook to be written as a parameter to + apply the localization information found in its FormatSettings. + Creates an internal instance of the number format list according to the + file format being read/written. + + @param AWorkbook Workbook from with the file is written. This parameter is + passed from the workbook which creates the writer. +-------------------------------------------------------------------------------} +constructor TsCustomSpreadWriter.Create(AWorkbook: TsWorkbook); +begin + inherited Create(AWorkbook); + // Number formats + CreateNumFormatList; +end; + +{@@ ---------------------------------------------------------------------------- + Destructor of the writer. + Destroys the internal number format list and the error log list. +-------------------------------------------------------------------------------} +destructor TsCustomSpreadWriter.Destroy; +begin + FreeAndNil(FNumFormatList); + inherited Destroy; +end; + +{@@ ---------------------------------------------------------------------------- + Creates an instance of the number format list which contains prototypes of + all number formats found in the workbook . + + The method has to be overridden because the descendants know the special + requirements of the file format. +-------------------------------------------------------------------------------} +procedure TsCustomSpreadWriter.CreateNumFormatList; +begin + // nothing to do here +end; + +{@@ ---------------------------------------------------------------------------- + If a color index is greater then the maximum palette color count this + color is replaced by the closest palette color. + + The present implementation does not change the color. Must be overridden by + writers of formats with limited palette sizes. + + @param AColor Color palette index to be checked + @return Closest color to AColor. If AColor belongs to the palette it must + be returned unchanged. +-------------------------------------------------------------------------------} +function TsCustomSpreadWriter.FixColor(AColor: TsColor): TsColor; +begin + Result := AColor; +end; + +{@@ ---------------------------------------------------------------------------- + If formatting features of a cell are not supported by the destination file + format of the writer, here is the place to apply replacements. + Must be overridden by descendants, nothin happens here. See BIFF2. + + @param ACell Pointer to the cell being investigated. Note that this cell + does not belong to the workbook, but is a cell of the + FFormattingStyles array. +-------------------------------------------------------------------------------} +procedure TsCustomSpreadWriter.FixFormat(ACell: PCell); +begin + Unused(ACell); + // to be overridden +end; + +{@@ ---------------------------------------------------------------------------- + Determines the size of the worksheet to be written. VirtualMode is respected. + Is called when the writer needs the size for output. Column and row count + limitations are repsected as well. + + @param AWorksheet Worksheet to be written + @param AFirsRow Index of first row to be written + @param ALastRow Index of last row + @param AFirstCol Index of first column to be written + @param ALastCol Index of last column to be written +-------------------------------------------------------------------------------} +procedure TsCustomSpreadWriter.GetSheetDimensions(AWorksheet: TsWorksheet; + out AFirstRow, ALastRow, AFirstCol, ALastCol: Cardinal); +begin + if (boVirtualMode in AWorksheet.Workbook.Options) then + begin + AFirstRow := 0; + AFirstCol := 0; + ALastRow := AWorksheet.Workbook.VirtualRowCount-1; + ALastCol := AWorksheet.Workbook.VirtualColCount-1; + end else + begin + Workbook.UpdateCaches; + AFirstRow := AWorksheet.GetFirstRowIndex; + if AFirstRow = Cardinal(-1) then + AFirstRow := 0; // this happens if the sheet is empty and does not contain row records + AFirstCol := AWorksheet.GetFirstColIndex; + if AFirstCol = Cardinal(-1) then + AFirstCol := 0; // this happens if the sheet is empty and does not contain col records + ALastRow := AWorksheet.GetLastRowIndex; + ALastCol := AWorksheet.GetLastColIndex; + end; + if AFirstCol >= Limitations.MaxColCount then + AFirstCol := Limitations.MaxColCount-1; + if AFirstRow >= Limitations.MaxRowCount then + AFirstRow := Limitations.MaxRowCount-1; + if ALastCol >= Limitations.MaxColCount then + ALastCol := Limitations.MaxColCount-1; + if ALastRow >= Limitations.MaxRowCount then + ALastRow := Limitations.MaxRowCount-1; +end; + +{@@ ---------------------------------------------------------------------------- + A generic method to iterate through all cells in a worksheet and call a callback + routine for each cell. + + @param AStream The output stream, passed to the callback routine. + @param ACells List of cells to be iterated + @param ACallback Callback routine; it requires as arguments a pointer to the + cell as well as the destination stream. +-------------------------------------------------------------------------------} +procedure TsCustomSpreadWriter.IterateThroughCells(AStream: TStream; + ACells: TAVLTree; ACallback: TCellsCallback); +var + AVLNode: TAVLTreeNode; +begin + AVLNode := ACells.FindLowest; + while Assigned(AVLNode) do + begin + ACallback(PCell(AVLNode.Data), AStream); + AVLNode := ACells.FindSuccessor(AVLNode); + end; +end; + +{@@ ---------------------------------------------------------------------------- + A generic method to iterate through all comments in a worksheet and call a + callback routine for each cell. + + @param AStream The output stream, passed to the callback routine. + @param AComments List of comments to be iterated + @param ACallback Callback routine; it requires as arguments a pointer to the + comment record as well as the destination stream. +-------------------------------------------------------------------------------} +procedure TsCustomSpreadWriter.IterateThroughComments(AStream: TStream; + AComments: TAVLTree; ACallback: TCommentsCallback); +var + AVLNode: TAVLTreeNode; + index: Integer; +begin + index := 0; + AVLNode := AComments.FindLowest; + while Assigned(AVLNode) do + begin + ACallback(PsComment(AVLNode.Data), index, AStream); + AVLNode := AComments.FindSuccessor(AVLNode); + inc(index); + end; +end; + +{@@ ---------------------------------------------------------------------------- + Iterates through all cells and collects the number formats in + FNumFormatList (without duplicates). + The index of the list item is needed for the field FormatIndex of the XF record. + At the time when the method is called the formats are still in fpc dialect. +-------------------------------------------------------------------------------} +procedure TsCustomSpreadWriter.ListAllNumFormats; +var + i: Integer; + fmt: PsCellFormat; +begin + for i:=0 to Workbook.GetNumCellFormats - 1 do + begin + fmt := Workbook.GetPointerToCellFormat(i); + if FNumFormatList.Find(fmt^.NumberFormat, fmt^.NumberFormatStr) = -1 then + FNumFormatList.AddFormat(fmt^.NumberFormat, fmt^.NumberFormatStr); + end; +end; + +{@@ ---------------------------------------------------------------------------- + Helper function for the spreadsheet writers. Writes the cell value to the + stream. Calls the WriteNumber method of the worksheet for writing a number, + the WriteDateTime method for writing a date/time etc. + + @param ACell Pointer to the worksheet cell being written + @param AStream Stream to which data are written + + @see TsCustomSpreadWriter.WriteCellsToStream +-------------------------------------------------------------------------------} +procedure TsCustomSpreadWriter.WriteCellCallback(ACell: PCell; AStream: TStream); +begin + if HasFormula(ACell) then + WriteFormula(AStream, ACell^.Row, ACell^.Col, ACell) + else + 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); + cctHyperlink: + WriteHyperlink(AStream, ACell^.Row, ACell^.Col, ACell); + end; + + if FWorksheet.ReadComment(ACell) <> '' then + WriteComment(AStream, ACell); +end; + +{@@ ---------------------------------------------------------------------------- + Helper function for the spreadsheet writers. + + Iterates all cells on a list, calling the appropriate write method for them. + + @param AStream The output stream. + @param ACells List of cells to be writeen +-------------------------------------------------------------------------------} +procedure TsCustomSpreadWriter.WriteCellsToStream(AStream: TStream; + ACells: TAVLTree); +begin + IterateThroughCells(AStream, ACells, WriteCellCallback); +end; + +{@@ ---------------------------------------------------------------------------- + (Pseudo-) abstract method writing a cell comment to the stream. + The cell comment is written immediately after the cell content. + NOTE: This is not good for XLSX and BIFF8. + + Must be overridden by descendents. + + @param ACell Pointer to the cell containing the comment to be written +-------------------------------------------------------------------------------} +procedure TsCustomSpreadWriter.WriteComment(AStream: TStream; ACell: PCell); +begin + Unused(AStream, ACell); +end; + +{@@ ---------------------------------------------------------------------------- + Basic method which is called when writing a formula to a stream. The formula + is already stored in the cell fields. + Present implementation does nothing. Needs to be overridden by descendants. + + @param AStream Stream to be written + @param ARow Row index of the cell containing the formula + @param ACol Column index of the cell containing the formula + @param ACell Pointer to the cell containing the formula and being written + to the stream +-------------------------------------------------------------------------------} +procedure TsCustomSpreadWriter.WriteFormula(AStream: TStream; + const ARow, ACol: Cardinal; ACell: PCell); +begin + Unused(AStream); + Unused(ARow, ACol, ACell); +end; + +{@@ ---------------------------------------------------------------------------- + Basic method which is called when writing a hyperlink to a stream. + Present implementation does nothing. Needs to be overridden by descendants. + + @param AStream Stream to be written + @param ARow Row index of the cell containing the hyperlink + @param ACol Column index of the cell containing the formula + @param ACell Pointer to the cell containing the hyperlink and + being written to the stream +-------------------------------------------------------------------------------} +procedure TsCustomSpreadWriter.WriteHyperlink(AStream: TStream; + const ARow, ACol: Cardinal; ACell: PCell); +begin + Unused(AStream); + Unused(ARow, ACol, ACell); +end; + +{@@ ---------------------------------------------------------------------------- + Default file writing method. + + Opens the file and calls WriteToStream + The workbook written is the one specified in the constructor of the writer. + + @param AFileName The output file name. + @param AOverwriteExisting If the file already exists it will be replaced. + + @see TsWorkbook +-------------------------------------------------------------------------------} +procedure TsCustomSpreadWriter.WriteToFile(const AFileName: string; + const AOverwriteExisting: Boolean = False); +var + OutputFile: TStream; + lMode: Word; +begin + if AOverwriteExisting then + lMode := fmCreate or fmOpenWrite + else + lMode := fmCreate; + + if (boBufStream in Workbook.Options) then + OutputFile := TBufStream.Create(AFileName, lMode) + else + OutputFile := TFileStream.Create(AFileName, lMode); + + try + WriteToStream(OutputFile); + finally + OutputFile.Free; + end; +end; + +{@@ ---------------------------------------------------------------------------- + This routine has the purpose to write the workbook to a stream. + Present implementation writes to a stringlists by means of WriteToStrings; + this behavior is required for wikitables. + Must be overriden in descendent classes for all other cases. + + @param AStream Stream to which the workbook is written +-------------------------------------------------------------------------------} +procedure TsCustomSpreadWriter.WriteToStream(AStream: TStream); +var + list: TStringList; +begin + list := TStringList.Create; + try + WriteToStrings(list); + list.SaveToStream(AStream); + finally + list.Free; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Writes the worksheet to a list of strings. Not implemented here, needs to + be overridden by descendants. See wikitables. +-------------------------------------------------------------------------------} +procedure TsCustomSpreadWriter.WriteToStrings(AStrings: TStrings); +begin + Unused(AStrings); + raise Exception.Create(rsUnsupportedWriteFormat); +end; + + + + +end. diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 6b508d14d..5c186f71d 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -87,6 +87,7 @@ function GetCellRangeString(ARange: TsCellRange; AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String; overload; function GetErrorValueStr(AErrorValue: TsErrorValue): String; +function GetFileFormatName(AFormat: TsSpreadsheetFormat): string; function IfThen(ACondition: Boolean; AValue1,AValue2: TsNumberFormat): TsNumberFormat; overload; @@ -837,6 +838,28 @@ begin end; end; +{@@ ---------------------------------------------------------------------------- + Returns the name of the given spreadsheet file format. + + @param AFormat Identifier of the file format + @return 'BIFF2', 'BIFF3', 'BIFF4', 'BIFF5', 'BIFF8', 'OOXML', 'Open Document', + 'CSV, 'WikiTable Pipes', or 'WikiTable WikiMedia" +-------------------------------------------------------------------------------} +function GetFileFormatName(AFormat: TsSpreadsheetFormat): string; +begin + case AFormat of + sfExcel2 : Result := 'BIFF2'; + sfExcel5 : Result := 'BIFF5'; + sfExcel8 : Result := 'BIFF8'; + sfooxml : Result := 'OOXML'; + sfOpenDocument : Result := 'Open Document'; + sfCSV : Result := 'CSV'; + sfWikiTable_Pipes : Result := 'WikiTable Pipes'; + sfWikiTable_WikiMedia : Result := 'WikiTable WikiMedia'; + else Result := rsUnknownSpreadsheetFormat; + end; +end; + {@@ ---------------------------------------------------------------------------- Helper function to reduce typing: "if a conditions is true return the first number format, otherwise return the second format" diff --git a/components/fpspreadsheet/fpsxmlcommon.pas b/components/fpspreadsheet/fpsxmlcommon.pas index 54f514f97..7acabd6da 100644 --- a/components/fpspreadsheet/fpsxmlcommon.pas +++ b/components/fpspreadsheet/fpsxmlcommon.pas @@ -10,7 +10,7 @@ interface uses Classes, SysUtils, laz2_xmlread, laz2_DOM, - fpspreadsheet; + fpSpreadsheet, fpsreaderwriter; type TsSpreadXMLReader = class(TsCustomSpreadReader) diff --git a/components/fpspreadsheet/laz_fpspreadsheet.lpk b/components/fpspreadsheet/laz_fpspreadsheet.lpk index 0b88121a1..fddc48cde 100644 --- a/components/fpspreadsheet/laz_fpspreadsheet.lpk +++ b/components/fpspreadsheet/laz_fpspreadsheet.lpk @@ -28,7 +28,7 @@ This package is all you need if you don't want graphical components (like grids and charts)."/> <License Value="LGPL with static linking exception. This is the same license as is used in the LCL (Lazarus Component Library)."/> <Version Major="1" Minor="5"/> - <Files Count="30"> + <Files Count="32"> <Item1> <Filename Value="fpolestorage.pas"/> <UnitName Value="fpolestorage"/> @@ -149,6 +149,14 @@ This package is all you need if you don't want graphical components (like grids <Filename Value="xlsescher.pas"/> <UnitName Value="xlsEscher"/> </Item30> + <Item31> + <Filename Value="fpsreaderwriter.pas"/> + <UnitName Value="fpsreaderwriter"/> + </Item31> + <Item32> + <Filename Value="fpsnumformat.pas"/> + <UnitName Value="fpsNumFormat"/> + </Item32> </Files> <RequiredPkgs Count="2"> <Item1> diff --git a/components/fpspreadsheet/laz_fpspreadsheet.pas b/components/fpspreadsheet/laz_fpspreadsheet.pas index ebe68ab6e..9dd4df3ca 100644 --- a/components/fpspreadsheet/laz_fpspreadsheet.pas +++ b/components/fpspreadsheet/laz_fpspreadsheet.pas @@ -12,7 +12,8 @@ uses fpsutils, fpszipper, uvirtuallayer_types, uvirtuallayer, uvirtuallayer_ole, uvirtuallayer_ole_helpers, uvirtuallayer_ole_types, uvirtuallayer_stream, fpolebasic, wikitable, fpsNumFormatParser, fpsfunc, fpsRPN, fpsStrings, - fpscsv, fpsCsvDocument, fpspatches, fpsTypes, xlsEscher; + fpscsv, fpsCsvDocument, fpspatches, fpsTypes, xlsEscher, fpsreaderwriter, + fpsNumFormat; implementation diff --git a/components/fpspreadsheet/tests/formattests.pas b/components/fpspreadsheet/tests/formattests.pas index 0a8723e62..e7d5de77d 100644 --- a/components/fpspreadsheet/tests/formattests.pas +++ b/components/fpspreadsheet/tests/formattests.pas @@ -156,7 +156,7 @@ type implementation uses - TypInfo, fpsPatches, fpsutils, fpsnumformatparser, fpscsv; + TypInfo, fpsPatches, fpsutils, fpsnumformat, fpscsv; const FmtNumbersSheet = 'NumbersFormat'; //let's distinguish it from the regular numbers sheet diff --git a/components/fpspreadsheet/tests/spreadtestcli.lpi b/components/fpspreadsheet/tests/spreadtestcli.lpi index eb3fa9d5b..81be348f3 100644 --- a/components/fpspreadsheet/tests/spreadtestcli.lpi +++ b/components/fpspreadsheet/tests/spreadtestcli.lpi @@ -13,6 +13,7 @@ <Title Value="spreadtestcli"/> <UseAppBundle Value="False"/> <ResourceType Value="res"/> + <Icon Value="-1"/> </General> <i18n> <EnableI18N LFM="False"/> @@ -69,7 +70,7 @@ <PackageName Value="LCLBase"/> </Item1> </RequiredPackages> - <Units Count="21"> + <Units Count="22"> <Unit0> <Filename Value="spreadtestcli.lpr"/> <IsPartOfProject Value="True"/> @@ -150,13 +151,16 @@ <Unit19> <Filename Value="copytests.pas"/> <IsPartOfProject Value="True"/> - <UnitName Value="copytests"/> </Unit19> <Unit20> <Filename Value="celltypetests.pas"/> <IsPartOfProject Value="True"/> - <UnitName Value="celltypetests"/> </Unit20> + <Unit21> + <Filename Value="commenttests.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="commenttests"/> + </Unit21> </Units> </ProjectOptions> <CompilerOptions> diff --git a/components/fpspreadsheet/tests/spreadtestcli.lpr b/components/fpspreadsheet/tests/spreadtestcli.lpr index b4e6f5837..53b0987a5 100644 --- a/components/fpspreadsheet/tests/spreadtestcli.lpr +++ b/components/fpspreadsheet/tests/spreadtestcli.lpr @@ -14,7 +14,8 @@ uses datetests, manualtests, stringtests, internaltests, testsutility, testutils, formattests, colortests, emptycelltests, insertdeletetests, errortests, numberstests, fonttests, formulatests, numformatparsertests, optiontests, - virtualmodetests, dbexporttests, sortingtests, copytests, celltypetests; + virtualmodetests, dbexporttests, sortingtests, copytests, celltypetests, + commenttests; const ShortOpts = 'ac:dhlpr:x'; diff --git a/components/fpspreadsheet/wikitable.pas b/components/fpspreadsheet/wikitable.pas index 386e0788e..a04688f2d 100644 --- a/components/fpspreadsheet/wikitable.pas +++ b/components/fpspreadsheet/wikitable.pas @@ -31,7 +31,7 @@ interface uses Classes, SysUtils, fpimage, fgl, lconvencoding, - fpsTypes, fpspreadsheet, fpsutils; + fpsTypes, fpSpreadsheet, fpsUtils, fpsReaderWriter; type diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas index 5c9471b3f..3feb86a7d 100755 --- a/components/fpspreadsheet/xlsbiff2.pas +++ b/components/fpspreadsheet/xlsbiff2.pas @@ -34,7 +34,7 @@ interface uses Classes, SysUtils, lconvencoding, - fpstypes, fpspreadsheet, xlscommon, fpsutils; + fpsTypes, fpsNumFormat, fpspreadsheet, fpsUtils, xlscommon; const BIFF2_MAX_PALETTE_SIZE = 8; @@ -159,7 +159,7 @@ var implementation uses - Math, fpsStrings, fpsNumFormatParser; + Math, fpsStrings, fpsReaderWriter, fpsNumFormatParser; const { Excel record IDs } diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas index a785bc907..6e83bb0bc 100755 --- a/components/fpspreadsheet/xlsbiff5.pas +++ b/components/fpspreadsheet/xlsbiff5.pas @@ -58,15 +58,15 @@ unit xlsbiff5; interface uses - Classes, SysUtils, fpcanvas, - fpstypes, fpspreadsheet, + Classes, SysUtils, fpcanvas, lconvencoding, + fpsTypes, fpsNumFormat, fpspreadsheet, xlscommon, {$ifdef USE_NEW_OLE} fpolebasic, {$else} fpolestorage, {$endif} - fpsutils, lconvencoding; + fpsUtils; type @@ -200,7 +200,7 @@ var implementation uses - fpsStrings, fpsStreams; + fpsStrings, fpsStreams, fpsReaderWriter; const { Excel record IDs } diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index cbbff5ea2..382d7fbcd 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -55,14 +55,14 @@ unit xlsbiff8; interface uses - Classes, SysUtils, fpcanvas, DateUtils, contnrs, - fpstypes, fpspreadsheet, xlscommon, + Classes, SysUtils, fpcanvas, DateUtils, contnrs, lazutf8, + fpstypes, fpsnumformat, fpspreadsheet, xlscommon, {$ifdef USE_NEW_OLE} fpolebasic, {$else} fpolestorage, {$endif} - fpsutils, lazutf8; + fpsutils; type @@ -243,7 +243,7 @@ implementation uses Math, lconvencoding, - fpsStrings, fpsStreams, fpsExprParser, xlsEscher; + fpsStrings, fpsStreams, fpsReaderWriter, fpsExprParser, xlsEscher; const { Excel record IDs } diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index dce0cc3ff..1f7afefda 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -10,8 +10,8 @@ OpenOffice Microsoft Excel File Format document } interface uses - Classes, SysUtils, DateUtils, - fpstypes, fpspreadsheet, fpsutils, lconvencoding; + Classes, SysUtils, DateUtils, lconvencoding, + fpsTypes, fpSpreadsheet, fpsUtils, fpsNumFormat, fpsReaderWriter; const { RECORD IDs which didn't change across versions 2-8 } diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 2263c61ca..86b058ffe 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -42,7 +42,8 @@ uses {$ELSE} fpszipper, {$ENDIF} - fpstypes, fpspreadsheet, fpsutils, fpsxmlcommon, xlscommon; + fpsTypes, fpSpreadsheet, fpsUtils, fpsReaderWriter, fpsNumFormat, + fpsxmlcommon, xlsCommon; type