From a4ee00f870c16f50abcdffab564a169dafd4ca64 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 12 Jun 2014 22:20:45 +0000 Subject: [PATCH] fpspreadsheet: Major reconstruction of numberformat parser to facilitate creation of xml formats for ods. Some minor regressions in unit tests and fpsgrid demo to be fixed. Removed elements "Decimals" and "CurrencySymbol" from TCell (this information is taken from the format string now). Removed the built-in format nfFmtDateTime (makes life easier, use nfCustom instead). git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3156 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/excel8demo/excel8read.lpi | 3 - .../examples/excel8demo/excel8write.lpr | 100 +- .../examples/fpsgrid/mainform.lfm | 68 +- .../examples/fpsgrid/mainform.pas | 52 +- .../fpspreadsheet/fpsnumformatparser.pas | 1759 ++++++++++++----- components/fpspreadsheet/fpsopendocument.pas | 11 +- components/fpspreadsheet/fpspreadsheet.pas | 569 +++--- components/fpspreadsheet/fpsutils.pas | 215 +- components/fpspreadsheet/tests/datetests.pas | 18 +- .../fpspreadsheet/tests/formattests.pas | 55 +- .../tests/numformatparsertests.pas | 9 +- .../fpspreadsheet/tests/spreadtestgui.lpi | 6 - components/fpspreadsheet/xlsbiff2.pas | 119 +- components/fpspreadsheet/xlsbiff8.pas | 2 + components/fpspreadsheet/xlscommon.pas | 200 +- 15 files changed, 2035 insertions(+), 1151 deletions(-) diff --git a/components/fpspreadsheet/examples/excel8demo/excel8read.lpi b/components/fpspreadsheet/examples/excel8demo/excel8read.lpi index 557786999..70ee0986d 100644 --- a/components/fpspreadsheet/examples/excel8demo/excel8read.lpi +++ b/components/fpspreadsheet/examples/excel8demo/excel8read.lpi @@ -64,9 +64,6 @@ - - - diff --git a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr b/components/fpspreadsheet/examples/excel8demo/excel8write.lpr index d8668c4b4..7c8174997 100644 --- a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr +++ b/components/fpspreadsheet/examples/excel8demo/excel8write.lpr @@ -53,9 +53,9 @@ begin { non-frozen panes not working, at the moment. Requires SELECTION records? MyWorksheet.LeftPaneWidth := 20*72*2; // 72 pt = inch --> 2 inches = 5 cm } - // Write some cells - MyWorksheet.WriteNumber(0, 0, 1.0, nfFixed, 3);// A1 + MyWorksheet.WriteNumber(0, 0, 0.0, nfSci, 1); +(* MyWorksheet.WriteNumber(0, 1, 2.0);// B1 MyWorksheet.WriteNumber(0, 2, 3.0);// C1 MyWorksheet.WriteNumber(0, 3, 4.0);// D1 @@ -131,7 +131,7 @@ begin MyWorksheet.WriteUTF8Text(8, 3, 'Colors...'); MyWorksheet.WriteFont(8, 3, 'Courier New', 12, [fssUnderline], scBlue); MyWorksheet.WriteBackgroundColor(8, 3, scYellow); - + {} { // Uncomment this to test large XLS files for i := 50 to 1000 do @@ -174,6 +174,9 @@ begin MyWorksheet.WriteUTF8Text(r, 0, 'Writing current date/time:'); inc(r, 2); // Write current date/time to cells B11:B16 + MyWorksheet.WriteUTF8Text(r, 0, '(default format)'); + MyWorksheet.WriteDateTime(r, 1, now); + inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfShortDate'); MyWorksheet.WriteDateTime(r, 1, now, nfShortDate); inc(r); @@ -189,11 +192,11 @@ begin MyWorksheet.WriteUTF8Text(r, 0, 'nfShortDateTime'); MyWorksheet.WriteDateTime(r, 1, now, nfShortDateTime); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfFmtDateTime, DM'); - MyWorksheet.WriteDateTime(r, 1, now, nfFmtDateTime, 'DM'); + MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, ''dd/mmm'''); + MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'dd/mmm'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfFmtDateTime, MY'); - MyWorksheet.WriteDateTime(r, 1, now, nfFmtDateTime, 'MY'); + MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, ''MMM/YY'''); + MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'mmm/yy'); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfShortTimeAM'); MyWorksheet.WriteDateTime(r, 1, now, nfShortTimeAM); @@ -201,14 +204,14 @@ begin MyWorksheet.WriteUTF8Text(r, 0, 'nfLongTimeAM'); MyWorksheet.WriteDateTime(r, 1, now, nfLongTimeAM); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfFmtDateTime, MS'); - MyWorksheet.WriteDateTime(r, 1, now, nfFmtDateTime, 'MS'); + MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, ''mm:ss'''); + MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'mm:ss'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfFmtDateTime, MSZ'); - MyWorksheet.WriteDateTime(r, 1, now, nfFmtDateTime, 'MSZ'); + MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, ''mm:ss.z'''); + MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'mm:ss.z'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfFmtDateTime, mm:ss.zzz'); - MyWorksheet.WriteDateTime(r, 1, now, nfFmtDateTime, 'mm:ss.zzz'); + MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, ''mm:ss.zzz'''); + MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'mm:ss.zzz'); // Write formatted numbers s := '31415.9265359'; @@ -301,26 +304,28 @@ begin MyWorksheet.WriteNumber(r, 3, 1.0/number, nfExp, 3); MyWorksheet.WriteNumber(r, 4, -1.0/number, nfExp, 3); inc(r,2); + MyWorksheet.WriteUTF8Text(r, 0, 'nfCurrency, 0 decs'); - MyWorksheet.WriteNumber(r, 1, number, nfCurrency, 0, 'USD'); - MyWorksheet.WriteNumber(r, 2, -number, nfCurrency, 0, 'USD'); - MyWorksheet.WriteNumber(r, 3, 0.0, nfCurrency, 0, 'USD'); + MyWorksheet.WriteCurrency(r, 1, number, nfCurrency, 0, 'USD'); + MyWorksheet.WriteCurrency(r, 2, -number, nfCurrency, 0, 'USD'); + MyWorksheet.WriteCurrency(r, 3, 0.0, nfCurrency, 0, 'USD'); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfCurrencyRed, 0 decs'); - MyWorksheet.WriteNumber(r, 1, number, nfCurrencyRed, 0, 'USD'); - MyWorksheet.WriteNumber(r, 2, -number, nfCurrencyRed, 0, 'USD'); - MyWorksheet.WriteNumber(r, 3, 0.0, nfCurrencyRed, 0, 'USD'); + MyWorksheet.WriteCurrency(r, 1, number, nfCurrencyRed, 0, 'USD'); + MyWorksheet.WriteCurrency(r, 2, -number, nfCurrencyRed, 0, 'USD'); + MyWorksheet.WriteCurrency(r, 3, 0.0, nfCurrencyRed, 0, 'USD'); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfAccounting, 0 decs'); - MyWorksheet.WriteNumber(r, 1, number, nfAccounting, 0, 'USD'); - MyWorksheet.WriteNumber(r, 2, -number, nfAccounting, 0, 'USD'); - MyWorksheet.WriteNumber(r, 3, 0.0, nfAccounting, 0, 'USD'); + MyWorksheet.WriteCurrency(r, 1, number, nfAccounting, 0, 'USD'); + MyWorksheet.WriteCurrency(r, 2, -number, nfAccounting, 0, 'USD'); + MyWorksheet.WriteCurrency(r, 3, 0.0, nfAccounting, 0, 'USD'); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfAccountingRed, 0 decs'); - MyWorksheet.WriteNumber(r, 1, -number, nfAccountingRed, 0, 'USD'); - MyWorksheet.WriteNumber(r, 2, number, nfAccountingRed, 0, 'USD'); - MyWorksheet.WriteNumber(r, 3, 0.0, nfAccountingRed, 0, 'USD'); + MyWorksheet.WriteCurrency(r, 1, -number, nfAccountingRed, 0, 'USD'); + MyWorksheet.WriteCurrency(r, 2, number, nfAccountingRed, 0, 'USD'); + MyWorksheet.WriteCurrency(r, 3, 0.0, nfAccountingRed, 0, 'USD'); + { inc(r,2); MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, "EUR "#,##0_);("EUR "#,##0)'); MyWorksheet.WriteNumber(r, 1, number); @@ -333,7 +338,7 @@ begin MyWorksheet.WriteNumberFormat(r, 1, nfCustom, '"$"#,##0.0_);[Red]("$"#,##0.0)'); MyWorksheet.WriteNumber(r, 2, -number); MyWorksheet.WriteNumberFormat(r, 2, nfCustom, '"$"#,##0.0_);[Red]("$"#,##0.0)'); - +} inc(r, 2); number := 1.333333333; MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 0 decs'); @@ -348,29 +353,44 @@ begin MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 3 decs'); MyWorksheet.WriteNumber(r, 1, number, nfPercentage, 3); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, hh:mm:ss'); + MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval Default=[h]:mm:ss'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, h:m:s'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'h:m:s'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, h:n:s'); - MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'h:n:s'); + MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [h]:m:s'); + MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[h]:m:s'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, hh:mm'); - MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'hh:mm'); + MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [h]:n:s'); + MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[h]:n:s'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, hh:nn'); - MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'hh:nn'); + MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [hh]:mm'); + MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[hh]:mm'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, h:m'); - MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'h:m'); + MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [hh]:nn'); + MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[hh]:nn'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, h:n'); - MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'h:n'); + MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval [h]:m'); + MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[h]:m'); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, h'); - MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'h'); + MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [h]:n'); + MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[h]:n'); + inc(r); + MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [h]'); + MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[h]'); + inc(r); + MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [m]:s'); + MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[m]:s'); + inc(r); + MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, m:s'); + MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'm:s'); + inc(r); + MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [mm]:ss'); + MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[mm]:ss'); + inc(r); + MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [ss]'); + MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[ss]'); // Set width of columns 0, 1 and 5 MyWorksheet.WriteColWidth(0, 30); @@ -395,7 +415,7 @@ begin MyWorksheet.WriteUTF8Text(0, 3, Str_Fourth); MyWorksheet.WriteTextRotation(0, 0, rt90DegreeClockwiseRotation); MyWorksheet.WriteUsedFormatting(0, 1, [uffBold]); - +*) // Save the spreadsheet to a file MyWorkbook.WriteToFile(MyDir + 'test.xls', sfExcel8, true); MyWorkbook.Free; diff --git a/components/fpspreadsheet/examples/fpsgrid/mainform.lfm b/components/fpspreadsheet/examples/fpsgrid/mainform.lfm index efa392184..6c2b22ad9 100644 --- a/components/fpspreadsheet/examples/fpsgrid/mainform.lfm +++ b/components/fpspreadsheet/examples/fpsgrid/mainform.lfm @@ -4,7 +4,7 @@ object Form1: TForm1 Top = 248 Width = 884 Caption = 'fpsGrid' - ClientHeight = 624 + ClientHeight = 629 ClientWidth = 884 Menu = MainMenu OnActivate = FormActivate @@ -14,7 +14,7 @@ object Form1: TForm1 object Panel1: TPanel Left = 0 Height = 85 - Top = 539 + Top = 544 Width = 884 Align = alBottom BevelOuter = bvNone @@ -23,9 +23,9 @@ object Form1: TForm1 TabOrder = 0 object CbShowHeaders: TCheckBox Left = 8 - Height = 24 + Height = 19 Top = 8 - Width = 116 + Width = 93 Caption = 'Show headers' Checked = True OnClick = CbShowHeadersClick @@ -34,9 +34,9 @@ object Form1: TForm1 end object CbShowGridLines: TCheckBox Left = 8 - Height = 24 + Height = 19 Top = 32 - Width = 125 + Width = 100 Caption = 'Show grid lines' Checked = True OnClick = CbShowGridLinesClick @@ -45,7 +45,7 @@ object Form1: TForm1 end object EdFrozenCols: TSpinEdit Left = 389 - Height = 28 + Height = 23 Top = 8 Width = 52 OnChange = EdFrozenColsChange @@ -53,7 +53,7 @@ object Form1: TForm1 end object EdFrozenRows: TSpinEdit Left = 389 - Height = 28 + Height = 23 Top = 39 Width = 52 OnChange = EdFrozenRowsChange @@ -61,37 +61,37 @@ object Form1: TForm1 end object Label1: TLabel Left = 304 - Height = 20 + Height = 15 Top = 13 - Width = 77 + Width = 62 Caption = 'Frozen cols:' FocusControl = EdFrozenCols ParentColor = False end object Label2: TLabel Left = 304 - Height = 20 + Height = 15 Top = 40 - Width = 82 + Width = 66 Caption = 'Frozen rows:' FocusControl = EdFrozenRows ParentColor = False end object CbReadFormulas: TCheckBox Left = 8 - Height = 24 + Height = 19 Top = 56 - Width = 120 + Width = 96 Caption = 'Read formulas' OnChange = CbReadFormulasChange TabOrder = 4 end object CbHeaderStyle: TComboBox Left = 152 - Height = 28 + Height = 23 Top = 8 Width = 116 - ItemHeight = 20 + ItemHeight = 15 ItemIndex = 2 Items.Strings = ( 'Lazarus' @@ -106,7 +106,7 @@ object Form1: TForm1 end object PageControl1: TPageControl Left = 0 - Height = 460 + Height = 465 Top = 79 Width = 884 ActivePage = TabSheet1 @@ -116,11 +116,11 @@ object Form1: TForm1 OnChange = PageControl1Change object TabSheet1: TTabSheet Caption = 'Sheet1' - ClientHeight = 427 + ClientHeight = 437 ClientWidth = 876 object WorksheetGrid: TsWorksheetGrid Left = 0 - Height = 427 + Height = 437 Top = 0 Width = 876 FrozenCols = 0 @@ -136,7 +136,7 @@ object Form1: TForm1 TitleStyle = tsNative OnSelection = WorksheetGridSelection ColWidths = ( - 56 + 42 64 64 64 @@ -244,19 +244,19 @@ object Form1: TForm1 end object FontComboBox: TComboBox Left = 52 - Height = 28 + Height = 23 Top = 2 Width = 127 - ItemHeight = 20 + ItemHeight = 15 OnSelect = FontComboBoxSelect TabOrder = 0 end object FontSizeComboBox: TComboBox Left = 179 - Height = 28 + Height = 23 Top = 2 Width = 48 - ItemHeight = 20 + ItemHeight = 15 Items.Strings = ( '8' '9' @@ -2455,70 +2455,70 @@ object Form1: TForm1 OnExecute = AcNumFormatExecute end object AcNFFmtDateTimeDM: TAction - Tag = 1111 + Tag = 1181 Category = 'Format' AutoCheck = True Caption = 'Day + month' OnExecute = AcNumFormatExecute end object AcNFFmtDateTimeMY: TAction - Tag = 1112 + Tag = 1182 Category = 'Format' AutoCheck = True Caption = 'Month + year' OnExecute = AcNumFormatExecute end object AcNFLongDate: TAction - Tag = 1130 + Tag = 1120 Category = 'Format' AutoCheck = True Caption = 'Long date' OnExecute = AcNumFormatExecute end object AcNFShortTime: TAction - Tag = 1140 + Tag = 1130 Category = 'Format' AutoCheck = True Caption = 'Short time' OnExecute = AcNumFormatExecute end object AcNFLongTime: TAction - Tag = 1150 + Tag = 1140 Category = 'Format' AutoCheck = True Caption = 'Long time' OnExecute = AcNumFormatExecute end object AcNFShortTimeAM: TAction - Tag = 1160 + Tag = 1150 Category = 'Format' AutoCheck = True Caption = 'Short time AM/PM' OnExecute = AcNumFormatExecute end object AcNFLongTimeAM: TAction - Tag = 1170 + Tag = 1160 Category = 'Format' AutoCheck = True Caption = 'Long time AM/PM' OnExecute = AcNumFormatExecute end object AcNFFmtDateTimeMS: TAction - Tag = 1113 + Tag = 1183 Category = 'Format' AutoCheck = True Caption = 'Minutes + seconds' OnExecute = AcNumFormatExecute end object AcNFFmtDateTimeMSZ: TAction - Tag = 1114 + Tag = 1184 Category = 'Format' AutoCheck = True Caption = 'Minutes + seconds + milliseconds' OnExecute = AcNumFormatExecute end object AcNFTimeInterval: TAction - Tag = 1180 + Tag = 1170 Category = 'Format' AutoCheck = True Caption = 'Time interval' diff --git a/components/fpspreadsheet/examples/fpsgrid/mainform.pas b/components/fpspreadsheet/examples/fpsgrid/mainform.pas index d9ad604c4..c43ab9079 100644 --- a/components/fpspreadsheet/examples/fpsgrid/mainform.pas +++ b/components/fpspreadsheet/examples/fpsgrid/mainform.pas @@ -271,7 +271,7 @@ var implementation uses - fpcanvas, fpsutils; + fpcanvas, fpsutils, fpsnumformatparser; const HORALIGN_TAG = 100; @@ -455,17 +455,25 @@ procedure TForm1.AcIncDecDecimalsExecute(Sender: TObject); var cell: PCell; decs: Byte; + parser: TsNumFormatParser; begin with WorksheetGrid do begin if Workbook = nil then exit; cell := Worksheet.FindCell(GetWorksheetRow(Row), GetWorksheetCol(Col)); if (cell <> nil) then begin - decs := cell^.Decimals; - if (Sender = AcIncDecimals) then - Worksheet.WriteDecimals(cell, decs+1); - if (Sender = AcDecDecimals) and (decs > 0) then - Worksheet.WriteDecimals(cell, decs-1); + parser := TsNumFormatParser.Create(Workbook, cell^.NumberFormatStr); + try + decs := parser.Decimals; + if (Sender = AcIncDecimals) then + Parser.Decimals := decs+1; + if (Sender = AcDecDecimals) and (decs > 0) then + Parser.Decimals := decs-1; + cell^.NumberFormatStr := parser.FormatString[nfdDefault]; + finally + parser.Free; + end; + Invalidate; end; end; end; @@ -477,23 +485,20 @@ end; procedure TForm1.AcNumFormatExecute(Sender: TObject); const - DATETIME_FMT: array[0..4] of string = ('', 'dm', 'my', 'ms', 'msz'); + DATETIME_CUSTOM: array[0..4] of string = ('', 'dm', 'my', 'ms', 'msz'); var nf: TsNumberFormat; c, r: Cardinal; cell: PCell; fmt: String; begin - if WorksheetGrid.Worksheet = nil then - exit; - if TAction(Sender).Checked then nf := TsNumberFormat((TAction(Sender).Tag - NUMFMT_TAG) div 10) else nf := nfGeneral; - if nf = nfFmtDateTime then - fmt := DATETIME_FMT[TAction(Sender).Tag mod 10] + if nf = nfCustom then + fmt := DATETIME_CUSTOM[TAction(Sender).Tag mod 10] else fmt := ''; @@ -508,17 +513,22 @@ begin Worksheet.WriteDateTime(cell, cell^.DateTimeValue, nf, fmt) else Worksheet.WriteDateTime(cell, cell^.NumberValue, nf, fmt); + end else + if IsCurrencyFormat(nf) then begin + if IsDateTimeFormat(cell^.NumberFormat) then + Worksheet.WriteCurrency(cell, cell^.DateTimeValue, nf, fmt) + else + Worksheet.WriteCurrency(cell, cell^.Numbervalue, nf, fmt); end else begin if IsDateTimeFormat(cell^.NumberFormat) then - Worksheet.WriteNumber(cell, cell^.DateTimeValue, nf, cell^.Decimals, cell^.CurrencySymbol) + Worksheet.WriteNumber(cell, cell^.DateTimeValue, nf, fmt) else - Worksheet.WriteNumber(cell, cell^.NumberValue, nf, cell^.Decimals, cell^.CurrencySymbol); + Worksheet.WriteNumber(cell, cell^.NumberValue, nf, fmt) end; else Worksheet.WriteNumberformat(cell, nf, fmt); end; end; - UpdateNumFormatActions; end; @@ -872,14 +882,12 @@ begin t := ac.Tag; if (ac.Tag >= NUMFMT_TAG) and (ac.Tag < NUMFMT_TAG + 200) then begin found := ((ac.Tag - NUMFMT_TAG) div 10 = ord(nf)); - if (nf = nfFmtDateTime) then + if nf = nfCustom then case (ac.Tag - NUMFMT_TAG) mod 10 of - 1: found := pos('d/m', cell^.NumberFormatStr) > 0; - 2: found := pos('m/y', cell^.NumberFormatStr) > 0; - 3: found := (pos('n:s', cell^.NumberFormatStr) > 0) - and (pos ('.z', cell^.NumberFormatStr) = 0); - 4: found := (pos('n:s', cell^.NumberFormatStr) > 0) - and (pos ('.z', cell^.NumberFormatStr) > 0); + 1: found := cell^.NumberFormatStr = 'dd/mmm'; + 2: found := cell^.NumberFormatStr = 'mmm/yy'; + 3: found := cell^.NumberFormatStr = 'nn:ss'; + 4: found := cell^.NumberFormatStr = 'nn:ss.z'; end; ac.Checked := found; end; diff --git a/components/fpspreadsheet/fpsnumformatparser.pas b/components/fpspreadsheet/fpsnumformatparser.pas index 7363ddee4..d0b3e6822 100644 --- a/components/fpspreadsheet/fpsnumformatparser.pas +++ b/components/fpspreadsheet/fpsnumformatparser.pas @@ -19,26 +19,49 @@ const psErrNoUsableFormat = 5; psErrNoValidNumberFormat = 6; psErrNoValidDateTimeFormat = 7; - psAmbiguousSymbol = 8; + psErrQuoteExpected = 8; + psAmbiguousSymbol = 9; { TsNumFormatParser } type + TsNumFormatDialect = (nfdDefault, nfdExcel, nfdOther); + // nfdDefault is the dialect used by fpc, + // nfdExcel is the dialect used by Excel + // nfdOther is used when writing xml for ods files. Separate implementation needed. + TsCompareOperation = (coNotUsed, coEqual, coNotEqual, coLess, coGreater, coLessEqual, coGreaterEqual ); - TsConversionDirection = (cdToFPSpreadsheet, cdFromFPSpreadsheet); + TsNumFormatToken = (nftText, nftThSep, nftDecSep, + nftYear, nftMonth, nftDay, nftHour, nftMinute, nftSecond, nftMilliseconds, + nftAMPM, nftMonthMinute, nftDateTimeSep, + nftSign, nftSignBracket, + nftDigit, nftOptDigit, nftDecs, nftOptDec, + nftExpChar, nftExpSign, nftExpDigits, + nftPercent, + nftCurrSymbol, nftCountry, + nftColor, nftCompareOp, nftCompareValue, + nftSpace, nftEscaped, + nftRepeat, nftEmptyCharWidth, + nftTextFormat); + + TsNumFormatElement = record + Token: TsNumFormatToken; + IntValue: Integer; + FloatValue: Double; + TextValue: String; + end; + + TsNumFormatElements = array of TsNumFormatElement; TsNumFormatSection = record - FormatString: String; - CompareOperation: TsCompareOperation; - CompareValue: Double; - Color: TsColor; - CountryCode: String; - CurrencySymbol: String; - Decimals: Byte; + Elements: TsNumFormatElements; NumFormat: TsNumberFormat; + Decimals: Byte; + CurrencySymbol: String; + Color: TsColor; end; TsNumFormatSections = array of TsNumFormatSection; @@ -47,53 +70,92 @@ type private FCreateMethod: Byte; FWorkbook: TsWorkbook; + FToken: Char; FCurrent: PChar; FStart: PChar; FEnd: PChar; FCurrSection: Integer; FSections: TsNumFormatSections; - FFormatSettings: TFormatSettings; - FFormatString: String; - FNumFormat: TsNumberFormat; - FConversionDirection: TsConversionDirection; - FIsTime: Boolean; - FIsAccounting: Boolean; FStatus: Integer; - function GetFormatString: String; + function GetCurrencySymbol: String; + function GetDecimals: byte; + function GetFormatString(ADialect: TsNumFormatDialect): String; + function GetNumFormat: TsNumberFormat; function GetParsedSectionCount: Integer; function GetParsedSections(AIndex: Integer): TsNumFormatSection; + procedure SetDecimals(AValue: Byte); protected - procedure AddChar(AChar: Char); + { Administration while scanning } + procedure AddElement(AToken: TsNumFormatToken; AText: String); overload; + procedure AddElement(AToken: TsNumFormatToken; AIntValue: Integer); overload; + procedure AddElement(AToken: TsNumFormatToken; AFloatValue: Double); overload; procedure AddSection; - procedure AnalyzeBracket(const AValue: String); - procedure AnalyzeText(const AValue: String); - procedure CheckSections; - function CreateFormatStringFromSection(ASection: Integer): String; virtual; - function CreateFormatStringFromSections: String; - procedure Parse(const AFormatString: String); - procedure ScanAMPM(var s: String); + function NextToken: Char; + function PrevToken: Char; + + { Scanning/parsing } + procedure ScanAMPM; + procedure ScanAndCount(ATestChar: Char; out ACount: Integer); procedure ScanBrackets; + procedure ScanCondition(AFirstChar: Char); + procedure ScanCurrSymbol; procedure ScanDateTime; - procedure ScanDateTimeParts(TestToken, Replacement: Char; var s: String); procedure ScanFormat; procedure ScanNumber; - procedure ScanText; + procedure ScanQuotedText; + // Main scanner + procedure Parse(const AFormatString: String); + + { Analysis while scanning } + procedure AnalyzeColor(AValue: String); + function AnalyzeCurrency(const AValue: String): Boolean; + + { Analysis after scanning } + // General + procedure CheckSections; + procedure CheckSection(ASection: Integer); + // Format string + function BuildFormatString(ADialect: TsNumFormatDialect): String; virtual; + function BuildFormatStringFromSection(ASection: Integer; + ADialect: TsNumFormatDialect): String; virtual; + // NumberFormat + procedure EvalNumFormatOfSection(ASection: Integer; out ANumFormat: TsNumberFormat; + out ADecimals: byte; out ACurrencySymbol: String; out AColor: TsColor); + function IsCurrencyAt(ASection, AIndex: Integer; out ANumFormat: TsNumberFormat; + out ADecimals: byte; out ACurrencySymbol: String; out AColor: TsColor): Boolean; + function IsDateAt(ASection,AIndex: Integer; var ANumberFormat: TsNumberFormat; + var ANextIndex: Integer): Boolean; + function IsNumberAt(ASection,AIndex: Integer; var ANumberFormat: TsNumberFormat; + var ADecimals: Byte; var ANextIndex: Integer): Boolean; + function IsSciAt(ASection,AIndex: Integer; var ANumberFormat: TsNumberFormat; + var ADecimals: Byte; var ANextIndex: Integer): Boolean; + function IsTextAt(AText: string; ASection, AIndex: Integer): Boolean; + function IsTimeAt(ASection,AIndex: Integer; var ANumberFormat: TsNumberFormat; + var ANextIndex: Integer): Boolean; + function IsTokenAt(AToken: TsNumFormatToken; ASection,AIndex: Integer): Boolean; public + constructor Create(AWorkbook: TsWorkbook; const AFormatString: String); +(* constructor Create(AWorkbook: TsWorkbook; const AFormatString: String; - AConversionDirection: TsConversionDirection = cdToFPSpreadsheet); overload; - constructor Create(AWorkbook: TsWorkbook; - const AFormatString: String; ANumFormat: TsNumberFormat; - AConversionDirection: TsConversionDirection = cdToFPSpreadsheet); overload; + ANumFormat: TsNumberFormat); overload; constructor Create(AWorkbook: TsWorkbook; const AFormatSections: TsNumFormatSections; AConversionDirection: TsConversionDirection = cdFromFPSpreadsheet); overload; + *) destructor Destroy; override; + (* procedure CopySections(const FromSections: TsNumFormatSections; var ToSections: TsNumFormatSections); procedure CopySectionsTo(var ADestination: TsNumFormatSections); - property Builtin_NumFormat: TsNumberFormat read FNumFormat; - property FormatString: String read GetFormatString; + *) + function GetDateTimeCode(ASection: Integer): String; + function IsDateTimeFormat: Boolean; + + property CurrencySymbol: String read GetCurrencySymbol; + property Decimals: Byte read GetDecimals write SetDecimals; + property FormatString[ADialect: TsNumFormatDialect]: String read GetFormatString; + property NumFormat: TsNumberFormat read GetNumFormat; property ParsedSectionCount: Integer read GetParsedSectionCount; property ParsedSections[AIndex: Integer]: TsNumFormatSection read GetParsedSections; property Status: Integer read FStatus; @@ -102,32 +164,34 @@ type implementation uses - StrUtils, fpsutils; + TypInfo, StrUtils, fpsutils; const COMPARE_STR: array[TsCompareOperation] of string = ( '', '=', '<>', '<', '>', '<=', '>' ); +var + globalfmt: String; + { TsNumFormatParser } { Creates a number format parser for analyzing a formatstring that has been read - from a spreadsheet file. The conversion, by default, will go FROM the file TO - the fpspreadsheet procedures. } + from a spreadsheet file. } constructor TsNumFormatParser.Create(AWorkbook: TsWorkbook; - const AFormatString: String; - AConversionDirection: TsConversionDirection = cdToFPSpreadsheet); + const AFormatString: String); begin + + + globalfmt := AFormatString; + + inherited Create; FCreateMethod := 0; - FConversionDirection := AConversionDirection; FWorkbook := AWorkbook; - FFormatSettings := DefaultFormatSettings; - FFormatSettings.DecimalSeparator := '.'; - FFormatSettings.ThousandSeparator := ','; Parse(AFormatString); end; - + (* constructor TsNumFormatParser.Create(AWorkbook: TsWorkbook; const AFormatString: String; ANumFormat: TsNumberFormat; AConversionDirection: TsConversionDirection = cdToFPSpreadsheet); @@ -150,8 +214,7 @@ end; the destination file format and, in general, will not work if called by fpspreadsheet. } constructor TsNumFormatParser.Create(AWorkbook: TsWorkbook; - const AFormatSections: TsNumFormatSections; - AConversionDirection: TsConversionDirection = cdFromFPSpreadsheet); + const AFormatSections: TsNumFormatSections); begin inherited Create; FCreateMethod := 1; @@ -159,141 +222,217 @@ begin FWorkbook := AWorkbook; CopySections(AFormatSections, FSections); end; - + *) destructor TsNumFormatParser.Destroy; begin FSections := nil; inherited Destroy; end; -procedure TsNumFormatParser.AddChar(AChar: Char); +procedure TsNumFormatParser.AddElement(AToken: TsNumFormatToken; AText: String); +var + n: Integer; begin - with FSections[FCurrSection] do - FormatString := FormatString + AChar; + n := Length(FSections[FCurrSection].Elements); + SetLength(FSections[FCurrSection].Elements, n+1); + FSections[FCurrSection].Elements[n].Token := AToken; + FSections[FCurrSection].Elements[n].TextValue := AText; +end; + +procedure TsNumFormatParser.AddElement(AToken: TsNumFormatToken; AIntValue: Integer); +var + n: Integer; +begin + n := Length(FSections[FCurrSection].Elements); + SetLength(FSections[FCurrSection].Elements, n+1); + FSections[FCurrSection].Elements[n].Token := AToken; + FSections[FCurrSection].Elements[n].IntValue := AIntValue; +end; + +procedure TsNumFormatParser.AddElement(AToken: TsNumFormatToken; AFloatValue: Double); overload; +var + n: Integer; +begin + n := Length(FSections[FCurrSection].Elements); + SetLength(FSections[FCurrSection].Elements, n+1); + FSections[FCurrSection].Elements[n].Token := AToken; + FSections[FCurrSection].Elements[n].FloatValue := AFloatValue; end; procedure TsNumFormatParser.AddSection; begin FCurrSection := Length(FSections); SetLength(FSections, FCurrSection + 1); - with FSections[FCurrSection] do begin - FormatString := ''; - CompareOperation := coNotUsed; - CompareValue := 0.0; - Color := scNotDefined; - CountryCode := ''; - CurrencySymbol := ''; - Decimals := 0; - NumFormat := nfGeneral; - end; - FIsTime := false; + with FSections[FCurrSection] do + SetLength(Elements, 0); end; -procedure TsNumFormatParser.AnalyzeBracket(const AValue: String); +procedure TsNumFormatParser.AnalyzeColor(AValue: String); var - lValue: String; - p, n: Integer; + n: Integer; begin - lValue := lowercase(AValue); - // date/time format for interval - if (lValue = 'h') or (lValue = 'hh') or (lValue = 'm') or (lValue = 'mm') or - (lValue = 's') or (lValue = 'ss') or (lValue = 'n') or (lValue = 'nn') - then begin - FSections[FCurrSection].FormatString := FSections[FCurrSection].FormatString + - '[' + AValue + ']'; - FSections[FCurrSection].NumFormat := nfTimeInterval; - FIsTime := true; - end - else - if ((lValue = 'n') or (lValue = 'nn')) and (FConversionDirection = cdFromFPSpreadsheet) - then begin - FSections[FCurrSection].FormatString := FSections[FCurrSection].FormatString + - '[' + DupeString('m', Length(lValue)) + ']'; - FIsTime := true; - end - else + AValue := lowercase(AValue); // Colors - if lValue = 'red' then - FSections[FCurrSection].Color := scRed + if AValue = 'red' then + AddElement(nftColor, ord(scRed)) else - if lValue = 'black' then - FSections[FCurrSection].Color := scBlack + if AValue = 'black' then + AddElement(nftColor, ord(scBlack)) else - if lValue = 'blue' then - FSections[FCurrSection].Color := scBlue + if AValue = 'blue' then + AddElement(nftColor, ord(scBlue)) else - if lValue = 'white' then - FSections[FCurrSection].Color := scWhite + if AValue = 'white' then + AddElement(nftColor, ord(scWhite)) else - if lValue = 'green' then - FSections[FCurrSection].Color := scGreen + if AValue = 'green' then + AddElement(nftColor, ord(scGreen)) else - if lValue = 'cyan' then - FSections[FCurrSection].Color := scCyan + if AValue = 'cyan' then + AddElement(nftColor, ord(scCyan)) else - if lValue = 'magenta' then - FSections[FCurrSection].Color := scMagenta + if AValue = 'magenta' then + AddElement(nftColor, ord(scMagenta)) else - if copy(lValue, 1, 5) = 'color' then begin - lValue := copy(lValue, 6, Length(lValue)); - if not TryStrToInt(trim(lValue), n) then begin + if copy(AValue, 1, 5) = 'color' then begin + AValue := copy(AValue, 6, Length(AValue)); + if not TryStrToInt(trim(AValue), n) then begin FStatus := psErrNoValidColorIndex; exit; end; - FSections[FCurrSection].Color := n; - end - else - // Conditions - if lValue[1] in ['=', '<', '>'] then begin - n := 1; - case lValue[1] of - '=': FSections[FCurrSection].CompareOperation := coEqual; - '<': case lValue[2] of - '>': begin FSections[FCurrSection].CompareOperation := coNotEqual; inc(n); end; - '=': begin FSections[FCurrSection].CompareOperation := coLessEqual; inc(n); end; - else FSections[FCurrSection].CompareOperation := coLess; - end; - '>': case lValue[2] of - '=': begin FSections[FCurrSection].CompareOperation := coGreaterEqual; inc(n); end; - else FSections[FCurrSection].CompareOperation := coGreater; - end; - end; - Delete(lValue, 1, n); - if not TryStrToFloat(trim(lValue), FSections[FCurrSection].CompareValue) then - FStatus := psErrNoValidCompareNumber; - end else - // Currency information - if lValue[1] = '$' then begin - p := pos('-', AValue); - with FSections[FCurrSection] do begin - if p = 0 then - CurrencySymbol := Copy(AValue, 2, Length(AValue)) - else - CurrencySymbol := Copy(AValue, 2, p-2); - FormatString := FormatString + CurrencySymbol; - end; + AddElement(nftColor, n); end else FStatus := psErrUnknownInfoInBrackets; end; -procedure TsNumFormatParser.AnalyzeText(const AValue: String); +function TsNumFormatParser.AnalyzeCurrency(const AValue: String): Boolean; var uValue: String; begin uValue := Uppercase(AValue); - if (uValue = '$') or (uValue = 'USD') or (uValue = '€') or (uValue = 'EUR') or - (uValue = '£') or (uValue = 'GBP') or (uValue = '¥') or (uValue = 'JPY') - then - FSections[FCurrSection].CurrencySymbol := AValue; + Result := (uValue = '$') or (uValue = 'USD') or + (uValue = '€') or (uValue = 'EUR') or + (uValue = '£') or (uValue = 'GBP') or + (uValue = '¥') or (uValue = 'JPY'); +end; + +{ Creates a formatstring for all sections. + Note: this implementation is only valid for the fpc and Excel dialects of + format string. Needs to be overridden for xml. } +function TsNumFormatParser.BuildFormatString(ADialect: TsNumFormatDialect): String; +var + i: Integer; +begin + if ADialect = nfdOther then + raise Exception.Create('nfdOther cannot be used in TsNumFormatParser.BuildFormatString'); + if Length(FSections) > 0 then begin + Result := BuildFormatStringFromSection(0, ADialect); + for i := 1 to High(FSections) do + Result := Result + ';' + BuildFormatStringFromSection(i, ADialect); + end else + Result := ''; +end; + +{ Creates a format string for the given section. This implementation covers + the formatstring dialects of fpc (nfdDefault) and Excel (nfdExcel). + Needs to be overridden for xml. } +function TsNumFormatParser.BuildFormatStringFromSection(ASection: Integer; + ADialect: TsNumFormatDialect): String; +var + element: TsNumFormatElement; + i: Integer; +begin + Result := ''; + + if ADialect = nfdOther then + raise Exception.Create('nfdOther cannot be used in TsNumFormatParser.BuildFormatString'); + + if (ASection < 0) and (ASection >= GetParsedSectionCount) then + exit; + for i := 0 to High(FSections[ASection].Elements) do begin + element := FSections[ASection].Elements[i]; + case element.Token of + nftText: + if element.TextValue <> '' then result := Result + '"' + element.TextValue + '"'; + nftThSep: + Result := Result + ','; + nftDecSep: + Result := Result + '.'; + nftDigit: + Result := Result + '0'; + nftOptDigit, nftOptDec: + Result := Result + '#'; + nftYear: + Result := Result + DupeString(IfThen(ADialect = nfdExcel, 'Y', 'y'), element.IntValue); + nftMonth: + Result := Result + DupeString(IfThen(ADialect = nfdExcel, 'M', 'm'), element.IntValue); + nftDay: + Result := Result + DupeString(IfThen(ADialect = nfdExcel, 'D', 'd'), element.IntValue); + nftHour: + if element.IntValue < 0 + then Result := Result + '[' + DupeString('h', -element.IntValue) + ']' + else Result := Result + DupeString('h', element.IntValue); + nftMinute: + if element.IntValue < 0 + then Result := result + '[' + DupeString(IfThen(ADialect = nfdExcel, 'm', 'n'), -element.IntValue) + ']' + else Result := Result + DupeString(IfThen(ADialect = nfdExcel, 'm', 'n'), element.IntValue); + nftSecond: + if element.IntValue < 0 + then Result := Result + '[' + DupeString('s', -element.IntValue) + ']' + else Result := Result + DupeString('s', element.IntValue); + nftDecs, nftExpDigits, nftMilliseconds: + Result := Result + Dupestring('0', element.IntValue); + nftSpace, nftSign, nftSignBracket, nftExpChar, nftExpSign, nftPercent, + nftAMPM, nftDateTimeSep: + if element.TextValue <> '' then Result := Result + element.TextValue; + nftCurrSymbol: + if element.TextValue <> '' then begin + if ADialect = nfdExcel then + Result := Result + '[$' + element.TextValue + ']' + else + Result := Result + '"' + element.TextValue + '"'; + end; + nftEscaped: + if element.TextValue <> '' then begin + if ADialect = nfdExcel then + Result := Result + '\' + element.TextValue + else + Result := Result + element.TextValue; + end; + nftTextFormat: + if element.TextValue <> '' then + if ADialect = nfdExcel then Result := Result + element.TextValue; + nftRepeat: + if element.TextValue <> '' then Result := Result + '*' + element.TextValue; + nftColor: + if ADialect = nfdExcel then + case element.IntValue of + scBlack : Result := '[black]'; + scWhite : Result := '[white]'; + scRed : Result := '[red]'; + scBlue : Result := '[blue]'; + scGreen : Result := '[green]'; + scYellow : Result := '[yellow]'; + scMagenta: Result := '[magenta]'; + scCyan : Result := '[cyan]'; + else Result := Format('[Color%d]', [element.IntValue]); + end; + end; + end; end; procedure TsNumFormatParser.CheckSections; var i: Integer; +{ ns: Integer; s: String; isCurr: Boolean; + } begin + for i:=0 to Length(FSections)-1 do + CheckSection(i); + (* ns := Length(FSections); if (ns > 1) and (FNumFormat in [nfCurrencyRed, nfAccountingRed]) then @@ -389,22 +528,103 @@ begin FFormatString := Format('%s;%s', [FFormatString, FSections[i].FormatString]); end else FStatus := psErrNoUsableFormat; + *) end; +procedure TsNumFormatParser.CheckSection(ASection: Integer); +var + i, j: Integer; + ok: Boolean; + + // Finds the previous date/time element skipping spaces, date/time sep etc. + function PrevDateTimeElement(j: Integer): Integer; + begin + Result := -1; + dec(j); + while (j >= 0) do begin + with FSections[ASection].Elements[j] do + if Token in [nftYear, nftMonth, nftDay, nftHour, nftMinute, nftSecond] then + begin + Result := j; + exit; + end; + dec(j); + end; + end; + + // Finds the next date/time element skipping spaces, date/time sep etc. + function NextDateTimeElement(j: Integer): Integer; + begin + Result := -1; + inc(j); + while (j < Length(FSections[ASection].Elements)) do begin + with FSections[ASection].Elements[j] do + if Token in [nftYear, nftMonth, nftDay, nftHour, nftMinute, nftSecond] then + begin + Result := j; + exit; + end; + inc(j); + end; + end; + +begin + // Fix the ambiguous "m": + for i:=0 to High(FSections[ASection].Elements) do + // Find index of nftMonthMinute token... + if FSections[ASection].Elements[i].Token = nftMonthMinute then begin + // ... and, using its neighbors, decide whether it is a month or a minute. + j := NextDateTimeElement(i); + if j <> -1 then + case FSections[ASection].Elements[j].Token of + nftDay, nftYear: + begin + FSections[ASection].Elements[i].Token := nftMonth; + Continue; + end; + nftSecond: + begin + FSections[ASection].Elements[i].Token := nftMinute; + Continue; + end; + end; + j := PrevDateTimeElement(i); + if j <> -1 then + case FSections[ASection].Elements[j].Token of + nftDay, nftYear: + begin + FSections[ASection].Elements[i].Token := nftMonth; + Continue; + end; + nftHour: + begin + FSections[ASection].Elements[i].Token := nftMinute; + Continue; + end; + end; + end; + + EvalNumFormatOfSection(ASection, + FSections[ASection].NumFormat, + FSections[ASection].Decimals, + FSections[ASection].CurrencySymbol, + FSections[ASection].Color + ); +end; + (* procedure TsNumFormatParser.CopySections( const FromSections: TsNumFormatSections; var ToSections: TsNumformatSections); var - i: Integer; + i, j: Integer; begin SetLength(ToSections, Length(FromSections)); for i:= 0 to High(FromSections) do begin - ToSections[i].FormatString := FromSections[i].FormatString; - ToSections[i].CompareOperation := FromSections[i].CompareOperation; - ToSections[i].CompareValue := FromSections[i].CompareValue; - ToSections[i].Color := FromSections[i].Color; - ToSections[i].CurrencySymbol := FromSections[i].CurrencySymbol; - ToSections[i].Decimals := FromSections[i].Decimals; ToSections[i].NumFormat := FromSections[i].NumFormat; + ToSections[i].Decimals := FromSections[i].Decimals; + ToSections[i].CurrencySymbol := FromSections[i].CurrencySymbol; + SetLength(ToSections[i].Elements, Length(FromSections[i].Elements)); + for j:=0 to High(ToSections[i].Elements) do + ToSections[i].Elements[j] := FromSections[i].Elements[j]; end; end; @@ -412,57 +632,205 @@ procedure TsNumFormatParser.CopySectionsTo(var ADestination: TsNumFormatSections begin CopySections(FSections, ADestination); end; + *) -function TsNumFormatParser.CreateFormatStringFromSections: String; +function TsNumFormatParser.GetFormatString(ADialect: TsNumFormatDialect): String; var i: Integer; begin - if Length(FSections) = 0 then - Result := '' - else begin - Result := CreateFormatStringFromSection(0); + Result := ''; + if Length(FSections) > 0 then begin + Result := BuildFormatStringFromSection(0, ADialect); for i:=1 to High(FSections) do - Result := Result + ';' + CreateFormatStringFromSection(i); + Result := Result + ';' + BuildFormatStringFromSection(i, ADialect); end; -end; - -function TsNumFormatParser.CreateFormatStringFromSection(ASection: Integer): String; -begin - with FSections[ASection] do - if (NumFormat = nfFmtDateTime) or (NumFormat = nfCustom) then begin - Result := FormatString; - exit; - end; - - Result := BuildNumberFormatString(FSections[ASection].NumFormat, - FWorkbook.FormatSettings, - FSections[ASection].Decimals, - FSections[ASection].CurrencySymbol - ); - if FConversionDirection = cdFromFPSpreadsheet then begin - // This is typical of Excel, but is valid for all others as well. - // Override if you need to change - if FSections[ASection].Color < 8 then - Result := Format('[%s]%s', [FWorkbook.GetColorName(FSections[ASection].Color), Result]) - else - if FSections[ASection].Color < scNotDefined then - Result := Format('[Color%d]%s', [FSections[ASection].Color, Result]); - - if FSections[ASection].CompareOperation <> coNotUsed then - Result := Format('[%s%g]%s', [ - COMPARE_STR[FSections[ASection].CompareOperation], - FSections[ASection].CompareValue, - Result - ]); - end; -end; - -function TsNumFormatParser.GetFormatString: String; -begin + { case FCreateMethod of 0: Result := FFormatString; 1: Result := CreateFormatStringFromSections; end; + } +end; + + +procedure TsNumFormatParser.EvalNumFormatOfSection(ASection: Integer; + out ANumFormat: TsNumberFormat; out ADecimals: byte; out ACurrencySymbol: String; + out AColor: TsColor); +var + nf: TsNumberFormat; + decs: Byte; + cs: String; + next: Integer; + ampm: Boolean; +begin + ANumFormat := nfCustom; + ADecimals := 0; + ACurrencySymbol := ''; + AColor := scNotDefined; + + with FSections[ASection] do begin + if Length(Elements) = 0 then begin + ANumFormat := nfGeneral; + exit; + end; + + // Look for number formats + if IsNumberAt(ASection, 0, ANumFormat, ADecimals, next) then begin + // nfFixed, nfFixedTh + if next = Length(Elements) then + exit; + // nfPercentage + if IsTokenAt(nftPercent, ASection, next) and (next+1 = Length(Elements)) + then begin + ANumFormat := nfPercentage; + exit; + end; + // nfExp + if IsTokenAt(nftExpChar, ASection, next) then begin + if IsTokenAt(nftExpSign, ASection, next+1) and IsTokenAt(nftExpDigits, ASection, next+2) and + (next+3 = Length(Elements)) + then begin + if ANumFormat = nfFixed then + ANumFormat := nfExp; + exit; + end; + end; + // nfCurrency + if IsCurrencyAt(ASection, 0, ANumFormat, ADecimals, ACurrencySymbol, AColor) + then exit; + end; + + // Look for scientific format + if IsSciAt(ASection, 0, ANumFormat, ADecimals, next) then + exit; + + // Look for date formats + if IsDateAt(ASection, 0, ANumFormat, next) then begin + if (next = Length(Elements)) then + exit; + if IsTextAt(' ', ASection, next) and IsTimeAt(ASection, next+1, nf, next) and + (next = Length(Elements)) + then begin + if (ANumFormat = nfShortDate) and (nf = nfShortTime) then + ANumFormat := nfShortDateTime; + end; + exit; + end; + + // Look for time formats + if IsTimeAt(ASection, 0, ANumFormat, next) then + if next = Length(Elements) then + exit; + end; + + // What is left must be a custom format. + ANumFormat := nfCustom; +end; + +{ Extracts the currency symbol form the formatting sections. It is assumed that + all two or three sections of the currency/accounting format use the same + currency symbol, otherwise it would be custom format anyway which ignores + the currencysymbol value. } +function TsNumFormatParser.GetCurrencySymbol: String; +begin + if Length(FSections) > 0 then + Result := FSections[0].CurrencySymbol + else + Result := ''; +end; + +{ Creates a string which summarizes the date/time formats in the given section. + The string contains a 'y' for a nftYear, a 'm' for a nftMonth, a + 'd' for a nftDay, a 'h' for a nftHour, a 'n' for a nftMinute, a 's' for a + nftSeconds, and a 'z' for a nftMilliseconds token. The order is retained. + Needed for biff2 } +function TsNumFormatParser.GetDateTimeCode(ASection: Integer): String; +var + i: Integer; +begin + Result := ''; + if ASection < Length(FSections) then + with FSections[ASection] do begin + i := 0; + while i < Length(Elements) do begin + case Elements[i].Token of + nftYear : Result := Result + 'y'; + nftMonth : Result := Result + 'm'; + nftDay : Result := Result + 'd'; + nftHour : Result := Result + 'h'; + nftMinute : Result := Result + 'n'; + nftMilliSeconds: Result := Result + 'z'; + end; + inc(i); + end; + end; +end; + +{ Extracts the number of decimals from the sections. Since they are needed only + for default formats having only a single section, only the first section is + considered. In case of currency/accounting having two or three sections, it is + assumed that all sections have the same decimals count, otherwise it would not + be a standard format. } +function TsNumFormatParser.GetDecimals: Byte; +begin + if Length(FSections) > 0 then + Result := FSections[0].Decimals + else + Result := 0; +end; + +{ Tries to extract a common builtin number format from the sections. If there + are multiple sections, it is always a custom format, except for Currency and + Accounting. } +function TsNumFormatParser.GetNumFormat: TsNumberFormat; +begin + if Length(FSections) = 0 then + result := nfGeneral + else begin + Result := FSections[0].NumFormat; + if (Result in [nfCurrency, nfAccounting]) then begin + if Length(FSections) = 2 then begin + if FSections[1].CurrencySymbol <> FSections[0].CurrencySymbol then begin + Result := nfCustom; + exit; + end; + if (FSections[0].NumFormat = nfCurrency) and (FSections[1].NumFormat = nfCurrency) then + exit; + if FSections[1].NumFormat = nfAccounting then begin + Result := nfAccounting; + exit; + end; + end else + if Length(FSections) = 3 then begin + if (FSections[0].CurrencySymbol <> FSections[1].CurrencySymbol) or + (FSections[1].CurrencySymbol <> FSections[2].CurrencySymbol) + then begin + Result := nfCustom; + exit; + end; + if (FSections[0].NumFormat = nfCurrency) and (FSections[1].NumFormat = nfCurrency) and + (FSections[2].NumFormat = nfCurrency) + then + exit; + if (FSections[1].NumFormat = nfAccounting) and + (FSections[2].NumFormat in [nfCurrency, nfAccounting]) + then begin + Result := nfAccounting; + exit; + end; + end; + Result := nfCustom; + exit; + end; + if Length(FSections) > 1 then begin + { + if IsDateTimeFormat then + Result := nfFmtDateTime + else + } + Result := nfCustom; + end; + end; end; function TsNumFormatParser.GetParsedSectionCount: Integer; @@ -475,9 +843,406 @@ begin Result := FSections[AIndex]; end; -procedure TsNumFormatParser.Parse(const AFormatString: String); +{ Checks if a currency-type of format string begins at index AIndex, and returns + the numberformat code, the count of decimals, the currency sambol, and the + color. + Note that the check is not very exact, but should cover most cases. } +function TsNumFormatParser.IsCurrencyAt(ASection, AIndex: Integer; + out ANumFormat: TsNumberFormat; out ADecimals: byte; + out ACurrencySymbol: String; out AColor: TsColor): Boolean; var - token: Char; + isAccounting : Boolean; + hasCurrSymbol: Boolean; + next: Integer; +begin + Result := false; + + ANumFormat := nfCustom; + ACurrencySymbol := ''; + ADecimals := 0; + AColor := scNotDefined; + + if IsTokenAt(nftColor, ASection, AIndex) then begin + AIndex := AIndex + 1; + AColor := FSections[ASection].Elements[AIndex].IntValue; + end; + + isAccounting := false; + hasCurrSymbol := false; + while (AIndex < Length(FSections[ASection].Elements)) do begin + case FSections[ASection].Elements[AIndex].Token of + nftRepeat: + isAccounting := true; + nftCurrSymbol: + begin + hasCurrSymbol := true; + ACurrencySymbol := FSections[ASection].Elements[AIndex].TextValue; + end; + nftOptDigit: + if IsNumberAt(ASection, AIndex, ANumFormat, ADecimals, next) then + AIndex := next-1 + else + exit; + end; + inc(AIndex); + end; + + Result := hasCurrSymbol and (ANumFormat = nfFixedTh); + if Result then begin + if isAccounting then begin + if AColor = scNotDefined then ANumFormat := nfAccounting else + if AColor = scRed then ANumFormat := nfAccountingRed; + end else begin + if AColor = scNotDefined then ANumFormat := nfCurrency else + if AColor = scRed then ANumFormat := nfCurrencyRed; + end; + end else + ANumFormat := nfCustom; +end; + +function TsNumFormatParser.IsDateAt(ASection,AIndex: Integer; + var ANumberFormat: TsNumberFormat; var ANextIndex: Integer): Boolean; + + function CheckFormat(AFmtStr: String; var idx: Integer): Boolean; + var + i: Integer; + s: String; + begin + Result := false; + idx := AIndex; + i := 1; + while (i < Length(AFmtStr)) and (idx < Length(FSections[ASection].Elements)) do begin + case AFmtStr[i] of + 'y', 'Y': + begin + if not IsTokenAt(nftYear, ASection, idx) then Exit; + inc(idx); + inc(i); + while (i < Length(AFmtStr)) and (AFmtStr[i] in ['y', 'Y']) do inc(i); + end; + 'm', 'M': + begin + if not IsTokenAt(nftMonth, ASection, idx) then Exit; + inc(idx); + inc(i); + while (i < Length(AFmtStr)) and (AFmtStr[i] in ['m', 'M']) do inc(i); + end; + 'd', 'D': + begin + if not IsTokenAt(nftDay, ASection, idx) then exit; + inc(idx); + inc(i); + while (i < Length(AFmtStr)) and (AFmtStr[i] in ['d', 'D']) do inc(i); + end; + '/': + begin + if not IsTokenAt(nftDateTimeSep, ASection, idx) then exit; + s := FSections[ASection].Elements[idx].TextValue; + if not ((s = '/') or (s = FWorkbook.FormatSettings.DateSeparator)) then + exit; + inc(idx); + inc(i); + end; + else + begin + if not (IsTokenAt(nftDateTimeSep, ASection, idx) and + (FSections[ASection].Elements[idx].textValue = AFmtStr[i])) + then + exit; + inc(idx); + inc(i); + end; + end; + end; // while ... + Result := true; + ANextIndex := idx; + end; + +var + i: Integer; +begin + // The default format nfShortDate is defined by the ShortDateFormat of the + // Workbook's FormatSettings. Check whether the current format string matches. + // But watch out for different date separators! + if CheckFormat(FWorkbook.FormatSettings.ShortDateFormat, ANextIndex) then begin + Result := true; + ANumberFormat := nfShortDate; + end else + // dto. with the LongDateFormat + if CheckFormat(FWorkbook.FormatSettings.LongDateFormat, ANextIndex) then begin + Result := true; + ANumberFormat := nfLongDate; + { + end else begin + // If it is neither nfShortDate nor nfLongDate we look for any year, month + // or day tokens. If we find one it must be at least nfFmtDateTime. + for i:=0 to High(FSections[ASection].Elements) do + if FSections[ASection].Elements[i].Token in [nftYear, nftMonth, nftDay] then begin + Result := true; + ANumberFormat := nfFmtDateTime; + exit; + end; + Result := false; + } + end else + Result := false; +end; + +{ Returns true if the format elements contain at least one date/time token } +function TsNumFormatParser.IsDateTimeFormat: Boolean; +var + section: Integer; + elem: Integer; +begin + Result := true; + for section := 0 to High(FSections) do + for elem := 0 to High(FSections[section].Elements) do + if FSections[section].Elements[elem].Token in [nftYear, nftMonth, nftDay, + nftHour, nftMinute, nftSecond] + then + exit; + Result := false; +end; + +{ Checks whether the format tokens beginning at AIndex for ASection represent + at standard number format, like nfFixed, nfPercentage etc. + Returns TRUE if it does. } +function TsNumFormatParser.IsNumberAt(ASection,AIndex: Integer; + var ANumberFormat: TsNumberFormat; var ADecimals: Byte; + var ANextIndex: Integer): Boolean; +var + nElem: Integer; +begin + Result := false; + ANumberFormat := nfGeneral; + ADecimals := 0; + ANextIndex := MaxInt; + nElem := Length(FSections[ASection].Elements); + // Let's look for digit tokens ('0') first + if IsTokenAt(nftDigit, ASection, AIndex) then begin // '0' + if IsTokenAt(nftDecSep, ASection, AIndex+1) and // '.' + IsTokenAt(nftDecs, ASection, AIndex+2) // count of decimals + then begin + // This is the case with decimal separator, like "0.000" + Result := true; + ANumberFormat := nfFixed; + ADecimals := FSections[ASection].Elements[AIndex+2].IntValue; + ANextIndex := AIndex+3; + end else + if not IsTokenAt(nftDecSep, ASection, AIndex+1) then begin + // and this is the (only) case without decimal separator ("0") + Result := true; + ANumberFormat := nfFixed; + ADecimals := 0; + ANextIndex := AIndex+1; + end; + end else + // Now look also for optional digits ('#') + if IsTokenAt(nftOptDigit, ASection, AIndex) and // '#' + IsTokenAt(nftThSep, ASection, AIndex+1) and // ',' + IsTokenAt(nftOptDigit, ASection, AIndex+2) and // '#' + IsTokenAt(nftOptDigit, ASection, Aindex+3) and // '#' + IsTokenAt(nftDigit, ASection, AIndex+4) // '0' + then begin + if IsTokenAt(nftDecSep, ASection, AIndex+5) and // '.' + IsTokenAt(nftDecs, ASection, AIndex+6) // count of decimals + then begin + // This is the case with decimal separator, like "#,##0.000" + Result := true; + ANumberFormat := nfFixedTh; + ADecimals := FSections[ASection].Elements[AIndex+6].IntValue; + ANextIndex := AIndex+7; + end else + if not IsTokenAt(nftDecSep, ASection, AIndex+5) then begin + // and this is without decimal separator, "#,##0" + result := true; + ANumberFormat := nfFixedTh; + ADecimals := 0; + ANextIndex := AIndex + 5; + end; + end; +end; + +function TsNumFormatParser.IsSciAt(ASection, AIndex: Integer; + var ANumberFormat: TsNumberFormat; var ADecimals: Byte; var ANextIndex: Integer): Boolean; +begin + if IsTokenAt(nftOptDigit, ASection, AIndex) and // '#' + IsTokenAt(nftOptDigit, ASection, Aindex+1) and // '#' + IsTokenAt(nftDigit, ASection, AIndex+2) and // '0' + IsTokenAt(nftDecSep, ASection, AIndex+3) and // '.' + IsTokenAt(nftDecs, ASection, AIndex+4) and // count of decimals + IsTokenAt(nftExpChar, ASection, AIndex+5) and // E + IsTokenAt(nftExpSign, ASection, AIndex+6) and // +/- + IsTokenAt(nftExpDigits, ASection, AIndex+7) + then begin + Result := true; + ANumberFormat := nfSci; + ADecimals := FSections[ASection].Elements[AIndex+4].IntValue; + ANextIndex := AIndex + 8; + end else + Result := false; +end; + +function TsNumFormatParser.IsTextAt(AText: String; ASection, AIndex: Integer): Boolean; +begin + Result := IsTokenAt(nftText, ASection, AIndex) and + (FSections[ASection].Elements[AIndex].TextValue = AText); +end; + +function TsNumFormatParser.IsTimeAt(ASection,AIndex: Integer; + var ANumberFormat: TsNumberFormat; var ANextIndex: Integer): Boolean; + + function CheckFormat(AFmtStr: String; var idx: Integer; + var AMPM, IsInterval: boolean): Boolean; + var + i: Integer; + s: String; + begin + Result := false; + AMPM := false; + IsInterval := false; + idx := AIndex; + i := 1; + while (i < Length(AFmtStr)) and (idx < Length(FSections[ASection].Elements)) do begin + case AFmtStr[i] of + 'h', 'H': + begin + if not IsTokenAt(nftHour, ASection, idx) then Exit; + if FSections[ASection].Elements[idx].IntValue < 0 then isInterval := true; + inc(idx); + inc(i); + while (i < Length(AFmtStr)) and (AFmtStr[i] in ['h', 'H']) do inc(i); + end; + 'm', 'M', 'n', 'N': + begin + if not IsTokenAt(nftMinute, ASection, idx) then Exit; + if FSections[ASection].Elements[idx].IntValue < 0 then isInterval := true; + inc(idx); + inc(i); + while (i < Length(AFmtStr)) and (AFmtStr[i] in ['m', 'M', 'n', 'N']) do inc(i); + end; + 's', 'S': + begin + if not IsTokenAt(nftSecond, ASection, idx) then exit; + if FSections[ASection].Elements[idx].IntValue < 0 then isInterval := true; + inc(idx); + inc(i); + while (i < Length(AFmtStr)) and (AFmtStr[i] in ['s', 'S']) do inc(i); + end; + ':': + begin + if not IsTokenAt(nftDateTimeSep, ASection, idx) then exit; + s := FSections[ASection].Elements[idx].TextValue; + if not ((s = ':') or (s = FWorkbook.FormatSettings.DateSeparator)) then + exit; + inc(idx); + inc(i); + end; + ' ': + if (i+1 <= Length(AFmtStr)) and (AFmtStr[i+1] in ['a', 'A']) then begin + inc(idx); + inc(i); + end else + exit; + 'a', 'A': + begin + if not IsTokenAt(nftAMPM, ASection, idx) then exit; + inc(idx); + inc(i); + while (i < Length(AFmtStr)) and (AFmtStr[i] in ['m','M','/','p','P']) do inc(i); + AMPM := true; + end; + '[': + begin + if not IsTokenAt(nftHour, ASection, idx+1) then exit; + if IsTextAt(']', ASection, idx+2) then begin + inc(i, 3); + inc(idx, 3); + IsInterval := true; + end else + if IsTokenAt(nftHour, ASection, idx+2) and IsTextAt(']', ASection, idx+3) then begin + inc(i, 4); + inc(idx, 4); + isInterval := true; + end else + exit; + end + else + exit; + end; + end; + Result := true; + ANextIndex := idx; + end; + +var + AMPM, isInterval: Boolean; + i: Integer; + fmt: String; +begin + Result := true; + fmt := AddAMPM(FWorkbook.FormatSettings.LongTimeFormat, FWorkbook.FormatSettings); + if CheckFormat(fmt, ANextIndex, AMPM, isInterval) then begin + ANumberFormat := IfThen(AMPM, nfLongTimeAM, IfThen(isInterval, nfTimeInterval, nfLongTime)); + exit; + end; + fmt := FWorkbook.FormatSettings.LongTimeFormat; + if CheckFormat(fmt, ANextIndex, AMPM, isInterval) then begin + ANumberFormat := IfThen(AMPM, nfLongTimeAM, IfThen(isInterval, nfTimeInterval, nfLongTime)); + exit; + end; + fmt := AddAMPM(FWorkbook.FormatSettings.ShortTimeFormat, FWorkbook.FormatSettings); + if CheckFormat(fmt, ANextIndex, AMPM, isInterval) then begin + ANumberFormat := IfThen(AMPM, nfShortTimeAM, nfShortTime); + exit; + end; + fmt := AddAMPM(FWorkbook.FormatSettings.ShortTimeFormat, FWorkbook.FormatSettings); + if CheckFormat(fmt, ANextIndex, AMPM, isInterval) then begin + ANumberFormat := IfThen(AMPM, nfShortTimeAM, nfShortTime); + exit; + end; + + for i:=0 to High(FSections[ASection].Elements) do + if (FSections[ASection].Elements[i].Token in [nftHour, nftMinute, nftSecond]) and + (FSections[ASection].Elements[i].IntValue < 0) + then begin + ANumberFormat := nfTimeInterval; + exit; + end; + + Result := false; +end; + +function TsNumFormatParser.IsTokenAt(AToken: TsNumFormatToken; + ASection, AIndex: Integer): Boolean; +begin + Result := (ASection < Length(FSections)) and + (AIndex < Length(FSections[ASection].Elements)) and + (FSections[ASection].Elements[AIndex].Token = AToken); +end; + +function TsNumFormatParser.NextToken: Char; +var + delta: Integer; +begin + if FCurrent < FEnd then begin + inc(FCurrent); + delta := integer(FCurrent - FStart); + Result := FCurrent^; + end else + Result := #0; +end; + +function TsNumFormatParser.PrevToken: Char; +begin + if FCurrent > nil then begin + dec(FCurrent); + Result := FCurrent^; + end else + Result := #0; +end; + +procedure TsNumFormatParser.Parse(const AFormatString: String); begin FStatus := psOK; AddSection; @@ -485,410 +1250,412 @@ begin exit; FStart := @AFormatString[1]; - FEnd := FStart + Length(AFormatString) - 1; + FEnd := FStart + Length(AFormatString); FCurrent := FStart; - while (FCurrent <= FEnd) and (FStatus = psOK) do begin - token := FCurrent^; - case token of + FToken := FCurrent^; + while (FCurrent < FEnd) and (FStatus = psOK) do begin + case FToken of '[': ScanBrackets; - ':': if FIsTime then AddChar(':'); + '"': ScanQuotedText; + ':': AddElement(nftDateTimeSep, ':'); ';': AddSection; else ScanFormat; end; - inc(FCurrent); + FToken := NextToken; end; + CheckSections; end; -{ Extracts the text between square brackets --> AnalyzeBracket } +{ Scans an AM/PM sequence (or AMPM or A/P). + At exit, cursor is a next character } +procedure TsNumFormatParser.ScanAMPM; +var + s: String; +begin + s := ''; + while (FCurrent < FEnd) do begin + if (FToken in ['A', 'a', 'P', 'p', 'm', 'M', '/']) then + s := s + FToken + else + break; + FToken := NextToken; + end; + AddElement(nftAMPM, s); +end; + +{ Counts the number of characters equal to ATestChar. Stops at the next + different character. This is also where the cursor is at exit. } +procedure TsNumFormatParser.ScanAndCount(ATestChar: Char; out ACount: Integer); +begin + ACount := 0; + repeat + inc(ACount); + FToken := NextToken; + until (FToken <> ATestChar) or (FCurrent >= FEnd); +end; + + +{ Extracts the text between square brackets. This can be + - a time duration like [hh] + - a condition, like [>= 2.0] + - a currency symbol like [$€-409] + - a color like [red] or [color25] + The procedure is left with the cursor at ']' } procedure TsNumFormatParser.ScanBrackets; var s: String; - token: Char; + n: Integer; + prevtoken: Char; begin - inc(FCurrent); // cursor stands at '[' - while (FCurrent <= FEnd) and (FStatus = psOK) do begin - token := FCurrent^; - case token of - ']': begin - AnalyzeBracket(s); - break; - end; + FToken := NextToken; // Cursor was at '[' + while (FCurrent < FEnd) and (FStatus = psOK) do begin + case FToken of + 'h', 'H', 'm', 'M', 'n', 'N', 's', 'S': + begin + prevtoken := FToken; + ScanAndCount(FToken, n); + if (FToken in [']', #0]) then begin + case prevtoken of + 'h', 'H' : AddElement(nftHour, -n); + 'm', 'M', 'n', 'N': AddElement(nftMinute, -n); + 's', 'S' : AddElement(nftSecond, -n); + end; + break; + end else + FStatus := psErrUnknownInfoInBrackets; + end; + + '<', '>', '=': + begin + ScanCondition(FToken); + if FToken = ']' then + break + else + FStatus := psErrUnknownInfoInBrackets; + end; + + '$': + begin + ScanCurrSymbol; + if FToken = ']' then + break + else + FStatus := psErrUnknownInfoInBrackets; + end; + + ']': + begin + AnalyzeColor(s); + break; + end; + else - s := s + token; + s := s + FToken; end; - inc(FCurrent); + FToken := NextToken; end; end; -{ Scans a date/time format. Note: fpc and the Excel-standard have slightly - different formats which are converted here } +{ Scans a condition like [>=2.0]. Starts after the "[" and ends before at "]". + Returns first character after the number (spaces allowed). } +procedure TsNumFormatParser.ScanCondition(AFirstChar: Char); +var + s: String; + op: TsCompareOperation; + value: Double; + res: Integer; +begin + s := AFirstChar; + FToken := NextToken; + if FToken in ['>', '<', '='] then s := s + FToken else FToken := PrevToken; + if s = '=' then op := coEqual else + if s = '<>' then op := coNotEqual else + if s = '<' then op := coLess else + if s = '>' then op := coGreater else + if s = '<=' then op := coLessEqual else + if s = '>=' then op := coGreaterEqual + else begin + FStatus := psErrUnknownInfoInBrackets; + FToken := #0; + exit; + end; + + while (FToken = ' ') and (FCurrent < FEnd) do + FToken := NextToken; + + if FCurrent >= FEnd then begin + FStatus := psErrUnknownInfoInBrackets; + FToken := #0; + exit; + end; + + s := FToken; + while (FCurrent < FEnd) and (FToken in ['+', '-', '.', '0'..'9']) do begin + FToken := NextToken; + s := s + FToken; + end; + val(s, value, res); + if res <> 0 then begin + FStatus := psErrUnknownInfoInBrackets; + FToken := #0; + exit; + end; + + while (FCurrent < FEnd) and (FToken = ' ') do + FToken := NextToken; + if FToken = ']' then + AddElement(nftCompareOp, value) + else begin + FStatus := psErrUnknownInfoInBrackets; + FToken := #0; + end; +end; + +{ Scans to end of a symbol like [$EUR-409], starting after the $ and ending at + the "]". + After the "$" follows the currency symbol, after the "-" country information } +procedure TsNumFormatParser.ScanCurrSymbol; +var + s: String; +begin + s := ''; + FToken := NextToken; + while (FCurrent < FEnd) and not (FToken in ['-', ']']) do begin + s := s + FToken; + FToken := NextToken; + end; + AddElement(nftCurrSymbol, s); + if FToken <> ']' then begin + FToken := NextToken; + while (FCurrent < FEnd) and (FToken <> ']') do begin + s := s + FToken; + FToken := NextToken; + end; + AddElement(nftCountry, s); + end; +end; + + +{ Scans a date/time format. Procedure is left with the cursor at the last char + of the date/time format. } procedure TsNumFormatParser.ScanDateTime; var + n: Integer; token: Char; - done: Boolean; - s: String; - i: Integer; - nf: TsNumberFormat; - partStr: String; - isAMPM: Boolean; - isDate: Boolean; // to distinguish whether "m" means "month" or "minute" (along with FIsTime) - P: PChar; + delta: Integer; begin - done := false; - s := ''; - isAMPM := false; - isDate := false; - - while (FCurrent <= FEnd) and (FStatus = psOK) and (not done) do begin - token := FCurrent^; - case token of + while (FCurrent < FEnd) and (FStatus = psOK) do begin + delta := Integer(FCurrent - FStart); + case FToken of '\': // means that the next character is taken literally begin - inc(FCurrent); // skip the "\"... - if FCurrent <= FEnd then begin - token := FCurrent^; // and take the next character - s := s + token; - end; + FToken := NextToken; // skip the "\"... + AddElement(nftEscaped, FToken); + FToken := NextToken; end; 'Y', 'y': begin - ScanDateTimeParts(token, token, s); - FIsTime := false; - isDate := true; + ScanAndCount(FToken, n); + AddElement(nftYear, n); end; - 'm', 'M': - if (token = 'M') and (FConversionDirection = cdToFPSpreadsheet) then - // Uppercase "M" in Excel = "month" --> "m" in fpspreadsheet - ScanDateTimeParts(token, 'm', s) - else begin - // not clear if "m" means "month" or "minute" -> look for next symbols - if (not isDate) and (not FIsTime) then begin - P := FCurrent; - inc(P); - while (P <= FEnd) and not done do begin - token := P^; - case token of - 'd','D','y','Y': - begin - isDate := true; // ok - it means "month" - FIsTime := false; - break; - end; - 'h','H','s','S': - begin - isDate := false; - FIsTime := true; // ok - it means "minute" - break; - end; - else - inc(P); - end; - end; - if P > FEnd then begin - // Special case of isolated "m" --> Error - FStatus := psAmbiguousSymbol; - break; - end; - end; - if FIsTime then // is "minute" - case FConversionDirection of - cdToFPSpreadsheet : ScanDateTimeParts(token, 'n', s); - cdFromFPSpreadsheet: ScanDateTimeParts(token, 'm', s); - end - else if isDate then // is "month" - case FConversionDirection of - cdToFPSpreadsheet : ScanDateTimeParts(token, 'm', s); - cdFromFPSpreadsheet: ScanDateTimeParts(token, 'M', s); - end; + 'm', 'M', 'n', 'N': + begin + ScanAndCount(FToken, n); + AddElement(nftMonthMinute, n); // Decide on minute or month later end; - 'N', 'n': - if FConversionDirection = cdToFPSpreadsheet then begin - // "n" is not used by file format --> stop scanning date/time - done := true; - dec(FCurrent); - end else - // "n", in fpc, stands for "minute". Excel wants "m" - ScanDateTimeParts(token, 'm', s); 'D', 'd': begin - ScanDateTimeParts(token, token, s); - FIsTime := false; - isDate := true; + ScanAndCount(FToken, n); + AddElement(nftDay, n); end; 'H', 'h': begin - ScanDateTimeParts(token, token, s); - FIsTime := true; - isDate := false; + ScanAndCount(FToken, n); + AddElement(nftHour, n); end; 'S', 's': begin - ScanDateTimeParts(token, token, s); - FIsTime := true; - isDate := false; + ScanAndCount(FToken, n); + AddElement(nftSecond, n); end; - '/', ':', '.', ']', '[', ' ': - s := s + token; - '0': - if FConversionDirection = cdToFPSpreadsheet then - ScanDateTimeParts(token, 'z', s) - else begin - done := true; - dec(FCurrent); + '/', ':': + begin + AddElement(nftDateTimeSep, FToken); + FToken := NextToken; + end; + '.': + begin + token := NextToken; + if token in ['z', '0'] then begin + AddElement(nftDecSep, FToken); + FToken := NextToken; + ScanAndCount(FToken, n); + AddElement(nftMilliseconds, n); + end else begin + AddElement(nftDateTimeSep, FToken); + FToken := token; + end; + end; + '[': + begin + ScanBrackets; + FToken := NextToken; end; - 'z', 'Z': - if FConversionDirection = cdToFPSpreadsheet then begin - done := true; - dec(FCurrent); - end else - ScanDateTimeParts(token, '0', s); 'A', 'a': - begin - ScanAMPM(s); - isAMPM := true; - end; + ScanAMPM; else - begin - done := true; - dec(FCurrent); - // char pointer must be at end of date/time mask. - end; - end; - if not done then inc(FCurrent); - end; - - FSections[FCurrSection].FormatString := FSections[FCurrSection].FormatString + s; - s := FSections[FCurrSection].FormatString; - if s <> '' then begin - if s = FWorkbook.FormatSettings.LongDateFormat then - nf := nfLongDate - else - if s = FWorkbook.FormatSettings.ShortDateFormat then - nf := nfShortDate - else - if (s = StripAMPM(FWorkbook.FormatSettings.LongTimeFormat)) and (not isAMPM) then - nf := nfLongTime - else - if (s = AddAMPM(FWorkbook.FormatSettings.LongTimeFormat, FWorkbook.FormatSettings)) and isAMPM then - nf := nfLongTimeAM - else - if (s = StripAMPM(FWorkbook.FormatSettings.ShortTimeFormat)) and (not isAMPM) then - nf := nfShortTime - else - if (s = AddAMPM(FWorkbook.FormatSettings.ShortTimeFormat, FWorkbook.FormatSettings)) and isAMPM then - nf := nfShortTimeAM - else - if s[1] = '[' then - nf := nfTimeInterval - else - nf := nfFmtDateTime; - - FSections[FCurrSection].NumFormat := nf; - end; -end; - -procedure TsNumFormatParser.ScanAMPM(var s: String); -var - token: Char; -begin - while (FCurrent <= FEnd) do begin - token := FCurrent^; - if token in ['A', 'a', 'P', 'p', 'm', 'M', '/'] then - s := s + token - else begin - dec(FCurrent); - exit; - end; - inc(FCurrent); - end; -end; - -procedure TsNumFormatParser.ScanDateTimeParts(TestToken, Replacement: Char; - var s: String); -var - token: Char; -begin - s := s + Replacement; - while (FCurrent <= FEnd) do begin - inc(FCurrent); - token := FCurrent^; - if token = TestToken then - s := s + Replacement - else begin - dec(FCurrent); - break; + // char pointer must be at end of date/time mask. + FToken := PrevToken; + Exit; end; end; end; procedure TsNumFormatParser.ScanFormat; var - token: Char; done: Boolean; begin done := false; - while (FCurrent <= FEnd) and (FStatus = psOK) and (not done) do begin - token := FCurrent^; - case token of - // Strip Excel's formatting symbols - '\': ; - '*': + while (FCurrent < FEnd) and (FStatus = psOK) and (not done) do begin + case FToken of + '\': // Excel: add next character literally begin - FIsAccounting := true; - AddChar('*'); - inc(FCurrent); - if (FCurrent <= FEnd) then begin - token := FCurrent^; - AddChar(token); - end; + FToken := NextToken; + AddElement(nftText, FToken); + end; + '*': // Excel: repeat next character to fill cell. For accounting format. + begin + FToken := NextToken; + AddElement(nftRepeat, FToken); + end; + '_': // Excel: Leave width of next character empty + begin + FToken := NextToken; + AddElement(nftEmptyCharWidth, FToken); + end; + '@': // Excel: Indicates text format + begin + AddElement(nftTextFormat, FToken); end; - '_': - inc(FCurrent); '"': - begin - inc(FCurrent); - ScanText; - end; + ScanQuotedText; '(', ')': - begin - AddChar(token); - end; + AddElement(nftSignBracket, FToken); '0', '#', '.', ',', '-': ScanNumber; 'y', 'Y', 'm', 'M', 'd', 'D', 'h', 'N', 'n', 's': ScanDateTime; '[': - begin - inc(FCurrent); - if (FCurrent <= FEnd) then begin - token := FCurrent^; - if token in ['h', 'H', 'n', 'N', 's', 'S'] then - ScanDateTime - else - if token = '$' then begin - dec(FCurrent, 2); - done := true; - end; - end; - end; + ScanBrackets; ' ': - AddChar(token); - ';': + AddElement(nftSpace, FToken); + 'A', 'a': begin - done := true; - dec(FCurrent); - // Cursor must stay on the ";" + ScanAMPM; + FToken := PrevToken; + end; + ';': // End of the section. Important: Cursor must stay on ';' + begin + AddSection; + Exit; end; end; - if not done then inc(FCurrent); + FToken := NextToken; end; end; +{ Scans a floating point format. Procedure is left with the cursor at the last + character of the format. } procedure TsNumFormatParser.ScanNumber; var - token: Char; - done: Boolean; - countdecs: Boolean; - s: String; + hasDecSep: Boolean; hasThSep: Boolean; - isExp: Boolean; - isSci: Boolean; - hasHash: Boolean; - hasPerc: Boolean; - nf: TsNumberFormat; + hasExp: Boolean; + n: Integer; + + delta: Integer; begin - countdecs := false; - done := false; + hasDecSep := false; hasThSep := false; - hasHash := false; - hasPerc := false; - isExp := false; - isSci := false; - s := ''; - while (FCurrent <= FEnd) and (FStatus = psOK) and (not done) do begin - token := FCurrent^; - case token of + hasExp := false; + while (FCurrent < FEnd) and (FStatus = psOK) do begin + + delta := integer(FCurrent - FStart); + + case FToken of ',': begin + AddElement(nftThSep, ','); hasThSep := true; - s := s + token; end; '.': begin - countdecs := true; - FSections[FCurrSection].Decimals := 0; - s := s + token; - end; - '0': begin - if countdecs then inc(FSections[FCurrSection].Decimals); - s := s + token; + AddElement(nftDecSep, '.'); + hasDecSep := true; end; + '0': if hasDecSep then begin + ScanAndCount('0', n); + FToken := PrevToken; + AddElement(nftDecs, n); + end else + AddElement(nftDigit, '0'); 'E', 'e': begin - if hasHash then isSci := true else isExp := true; - countdecs := false; - s := s + token; + AddElement(nftExpChar, FToken); + FToken := NextToken; + if FToken in ['+', '-'] then + AddElement(nftExpSign, FToken); + FToken := NextToken; + if FToken = '0' then begin + ScanAndCount('0', n); + FToken := PrevToken; + AddElement(nftExpDigits, n); + end; end; '+', '-': - s := s + token; - '#': begin - if not countdecs then hasHash := true; - s := s + token; - end; - '%': begin - hasPerc := true; - s := s + token; - end; - else begin - done := true; - dec(FCurrent); - end; + AddElement(nftSign, FToken); + '#': AddElement(nftOptDigit, FToken); + '%': AddElement(nftPercent, FToken); + else + FToken := PrevToken; + Exit; end; - if not done then - inc(FCurrent); + FToken := NextToken; end; - - if s <> '' then begin - if isExp then - nf := nfExp - else if isSci then - nf := nfSci - else if hasPerc then - nf := nfPercentage - else if hasThSep then - nf := nfFixedTh - else if FIsAccounting then - nf := nfAccounting - else - nf := nfFixed; - end else - nf := nfGeneral; - - FSections[FCurrSection].NumFormat := nf; - FSections[FCurrSection].FormatString := FSections[FCurrSection].FormatString + s; end; { Scans a text in quotation marks. Tries to interpret the text as a currency - symbol (--> AnalyzeText) } -procedure TsNumFormatParser.ScanText; + symbol (--> AnalyzeText). + The procedure is entered and left with the cursor at a quotation mark. } +procedure TsNumFormatParser.ScanQuotedText; var - token: Char; - done: Boolean; s: String; begin - done := false; s := ''; - while (FCurrent <= FEnd) and (FStatus = psOK) and not done do begin - token := FCurrent^; - if token = '"' then begin - done := true; - AnalyzeText(s); + FToken := NextToken; // Cursor war at '"' + while (FCurrent < FEnd) and (FStatus = psOK) do begin + if FToken = '"' then begin + if AnalyzeCurrency(s) then + AddElement(nftCurrSymbol, s) + else + AddElement(nftText, s); + exit; end else begin - s := s + token; - inc(FCurrent); + s := s + FToken; + FToken := NextToken; end; end; - FSections[FCurrSection].FormatString := Format('%s"%s"', - [FSections[FCurrSection].FormatString, s]); + // When the procedure gets here the final quotation mark is missing + FStatus := psErrQuoteExpected; +end; + +procedure TsNumFormatParser.SetDecimals(AValue: Byte); +var + i,j: Integer; +begin + for j := 0 to High(FSections) do + for i := 0 to High(FSections[j].Elements) do + if FSections[j].Elements[i].Token = nftDecs then + FSections[j].Elements[i].IntValue := AValue; end; end. diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index bb47a49c8..cc3789857 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -452,8 +452,6 @@ begin Include(ACell^.UsedFormattingFields, uffNumberFormat); ACell^.NumberFormat := numFmtData.NumFormat; ACell^.NumberFormatStr := numFmtData.FormatString; - ACell^.Decimals := numFmtData.Decimals; - ACell^.CurrencySymbol := numFmtData.CurrencySymbol; end; end; end; @@ -1074,7 +1072,7 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode); if negfmt <> '' then AFormatStr := AFormatStr + ';' + negfmt; if zerofmt <> '' then AFormatStr := AFormatStr + ';' + zerofmt; - if ANumFormat <> nfFmtDateTime then +// if ANumFormat <> nfFmtDateTime then ANumFormat := nfCustom; end; @@ -1141,7 +1139,7 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode); else if ANumFormatNode.NodeName = 'number:currency-style' then nf := nfCurrency; - NumFormatList.AddFormat(ANumFormatName, fmt, nf, decs, cs); + NumFormatList.AddFormat(ANumFormatName, fmt, nf); end; procedure ReadDateTimeStyle(ANumFormatNode: TDOMNode; ANumFormatName: String); @@ -1233,7 +1231,8 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode); node := node.NextSibling; end; - nf := IfThen(isInterval, nfTimeInterval, nfFmtDateTime); +// nf := IfThen(isInterval, nfTimeInterval, nfFmtDateTime); + nf := IfThen(isInterval, nfTimeInterval, nfCustom); node := ANumFormatNode.FindNode('style:map'); if node <> nil then ReadStyleMap(node, nf, fmt); @@ -1271,9 +1270,11 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode); node := ANumFormatNode.FindNode('style:map'); if node <> nil then ReadStyleMap(node, nf, fmt); + { if IsDateTimeFormat(fmt) then nf := nfFmtDateTime else + } nf := nfCustom; NumFormatList.AddFormat(ANumFormatName, fmt, nf); diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 4af7c96c3..b11783180 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -174,11 +174,46 @@ type // currency nfCurrency, nfCurrencyRed, nfAccounting, nfAccountingRed, // dates and times - nfShortDateTime, nfFmtDateTime, nfShortDate, nfLongDate, nfShortTime, nfLongTime, + nfShortDateTime, {nfFmtDateTime, }nfShortDate, nfLongDate, nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, nfTimeInterval, // other (format string goes directly into the file) nfCustom); +const + { @@ Codes for curreny format according to FormatSettings.CurrencyFormat: + "C" = currency symbol, "V" = currency value, "S" = space character + For the negative value formats, we use also: + "B" = bracket, "M" = Minus + The order of these characters represents the order of these items. + Example: 1000 dollars --> "$1000" for pCV, or "1000 $" for pVsC + -1000 dollars --> "($1000)" for nbCVb, or "-$ 1000" for nMCSV + Assignment taken from "sysstr.inc" } + + pcfDefault = -1; // use value from Worksheet.FormatSettings.CurrencyFormat + pcfCV = 0; // $1000 + pcfVC = 1; // 1000$ + pcfCSV = 2; // $ 1000 + pcfVSC = 3; // 1000 $ + + ncfDefault = -1; // use value from Worksheet.FormatSettings.NegCurrFormat + ncfBCVB = 0; // ($1000) + ncfMCV = 1; // -$1000 + ncfCMV = 2; // $-1000 + ncfCVM = 3; // $1000- + ncfBVCB = 4; // (1000$) + ccfMVC = 5; // -1000$ + ncfVMC = 6; // 1000-$ + ncfVCM = 7; // 1000$- + ncfMVSC = 8; // -1000 $ + ncfMCSV = 9; // -$ 1000 + ncfVSCM = 10; // 1000 $- + ncfCSVM = 11; // $ 1000- + ncfCSMV = 12; // $ -1000 + ncfVMSC = 13; // 1000- $ + ncfBCSVB = 14; // ($ 1000) + ncfBVSCB = 15; // (1000 $) + +type {@@ Text rotation formatting. The text is rotated relative to the standard orientation, which is from left to right horizontal: ---> @@ -328,8 +363,6 @@ type BackgroundColor: TsColor; NumberFormat: TsNumberFormat; NumberFormatStr: String; - Decimals: Byte; - CurrencySymbol: String; RGBBackgroundColor: TFPColor; // only valid if BackgroundColor=scRGBCOLOR end; @@ -396,22 +429,9 @@ type { Utils } class function CellPosToText(ARow, ACol: Cardinal): string; + procedure RemoveAllCells; - { Data manipulation methods - For Cells } - procedure CopyCell(AFromRow, AFromCol, AToRow, AToCol: Cardinal; AFromWorksheet: TsWorksheet); - procedure CopyFormat(AFormat: PCell; AToRow, AToCol: Cardinal); overload; - procedure CopyFormat(AFromCell, AToCell: PCell); overload; - function FindCell(ARow, ACol: Cardinal): PCell; - function GetCell(ARow, ACol: Cardinal): PCell; - function GetCellCount: Cardinal; - function GetFirstCell(): PCell; - function GetNextCell(): PCell; - function GetFirstCellOfRow(ARow: Cardinal): PCell; - function GetLastCellOfRow(ARow: Cardinal): PCell; - function GetLastColIndex: Cardinal; - function GetLastColNumber: Cardinal; deprecated 'Use GetLastColIndex'; - function GetLastRowIndex: Cardinal; - function GetLastRowNumber: Cardinal; deprecated 'Use GetLastRowIndex'; + { Reading of values } function ReadAsUTF8Text(ARow, ACol: Cardinal): ansistring; overload; function ReadAsUTF8Text(ACell: PCell): ansistring; overload; function ReadAsNumber(ARow, ACol: Cardinal): Double; @@ -421,25 +441,46 @@ type function ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields; function ReadBackgroundColor(ARow, ACol: Cardinal): TsColor; - procedure RemoveAllCells; - { Writing of values } procedure WriteBlank(ARow, ACol: Cardinal); procedure WriteBoolValue(ARow, ACol: Cardinal; AValue: Boolean); + + procedure WriteCurrency(ARow, ACol: Cardinal; AValue: Double; + AFormat: TsNumberFormat = nfCurrency; ADecimals: Integer = 2; + ACurrencySymbol: String = '?'; APosCurrFormat: Integer = -1; + ANegCurrFormat: Integer = -1); overload; + procedure WriteCurrency(ACell: PCell; AValue: Double; + AFormat: TsNumberFormat = nfCurrency; ADecimals: Integer = -1; + ACurrencySymbol: String = '?'; APosCurrFormat: Integer = -1; + ANegCurrFormat: Integer = -1); overload; + procedure WriteCurrency(ARow, ACol: Cardinal; AValue: Double; + AFormat: TsNumberFormat; AFormatString: String); overload; + procedure WriteCurrency(ACell: PCell; AValue: Double; + AFormat: TsNumberFormat; AFormatString: String); overload; + procedure WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime; - AFormat: TsNumberFormat = nfGeneral; AFormatStr: String = ''); overload; + AFormat: TsNumberFormat = nfShortDateTime; AFormatStr: String = ''); overload; procedure WriteDateTime(ACell: PCell; AValue: TDateTime; - AFormat: TsNumberFormat = nfGeneral; AFormatStr: String = ''); overload; + AFormat: TsNumberFormat = nfShortDateTime; AFormatStr: String = ''); overload; + procedure WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime; + AFormatStr: String); overload; + procedure WriteDateTime(ACell: PCell; AValue: TDateTime; + AFormatStr: String); overload; + procedure WriteErrorValue(ARow, ACol: Cardinal; AValue: TsErrorValue); overload; procedure WriteErrorValue(ACell: PCell; AValue: TsErrorValue); overload; procedure WriteFormula(ARow, ACol: Cardinal; AFormula: TsFormula); + procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double; AFormat: TsNumberFormat = nfGeneral; ADecimals: Byte = 2; ACurrencySymbol: String = ''); overload; procedure WriteNumber(ACell: PCell; ANumber: Double; AFormat: TsNumberFormat = nfGeneral; ADecimals: Byte = 2; ACurrencySymbol: String = ''); overload; procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double; - AFormatString: String); overload; + AFormat: TsNumberFormat; AFormatString: String); overload; + procedure WriteNumber(ACell: PCell; ANumber: Double; + AFormat: TsNumberFormat; AFormatString: String); overload; + procedure WriteRPNFormula(ARow, ACol: Cardinal; AFormula: TsRPNFormula); procedure WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring); overload; procedure WriteUTF8Text(ACell: PCell; AText: ansistring); overload; @@ -483,6 +524,22 @@ type procedure WriteWordwrap(ARow, ACol: Cardinal; AValue: boolean); + { Data manipulation methods - For Cells } + procedure CopyCell(AFromRow, AFromCol, AToRow, AToCol: Cardinal; AFromWorksheet: TsWorksheet); + procedure CopyFormat(AFormat: PCell; AToRow, AToCol: Cardinal); overload; + procedure CopyFormat(AFromCell, AToCell: PCell); overload; + function FindCell(ARow, ACol: Cardinal): PCell; + function GetCell(ARow, ACol: Cardinal): PCell; + function GetCellCount: Cardinal; + function GetFirstCell(): PCell; + function GetNextCell(): PCell; + function GetFirstCellOfRow(ARow: Cardinal): PCell; + function GetLastCellOfRow(ARow: Cardinal): PCell; + function GetLastColIndex: Cardinal; + function GetLastColNumber: Cardinal; deprecated 'Use GetLastColIndex'; + function GetLastRowIndex: Cardinal; + function GetLastRowNumber: Cardinal; deprecated 'Use GetLastRowIndex'; + { Data manipulation methods - For Rows and Cols } function FindRow(ARow: Cardinal): PRow; function FindCol(ACol: Cardinal): PCol; @@ -506,7 +563,7 @@ type property Rows: TIndexedAVLTree read FRows; property Workbook: TsWorkbook read FWorkbook; - // These are properties to interface to fpspreadsheetgrid. + // These are properties to interface to TsWorksheetGrid property Options: TsSheetOptions read FOptions write FOptions; property LeftPaneWidth: Integer read FLeftPaneWidth write FLeftPaneWidth; property TopPaneHeight: Integer read FTopPaneHeight write FTopPaneHeight; @@ -608,8 +665,6 @@ type Index: Integer; Name: String; NumFormat: TsNumberFormat; - Decimals: Byte; - CurrencySymbol: String; FormatString: string; end; @@ -630,27 +685,21 @@ type destructor Destroy; override; function AddFormat(AFormatCell: PCell): Integer; overload; function AddFormat(AFormatIndex: Integer; AFormatName, AFormatString: String; - ANumFormat: TsNumberFormat; ADecimals: Byte = 0; - ACurrencySymbol: String = ''): Integer; overload; + ANumFormat: TsNumberFormat): Integer; overload; function AddFormat(AFormatIndex: Integer; AFormatString: String; - ANumFormat: TsNumberFormat; ADecimals: Byte = 0; - ACurrencySymbol: String = ''): Integer; overload; + ANumFormat: TsNumberFormat): Integer; overload; function AddFormat(AFormatName, AFormatString: String; - ANumFormat: TsNumberFormat; ADecimals: Byte = 0; - ACurrencySymbol: String = ''): Integer; overload; - function AddFormat(AFormatString: String; ANumFormat: TsNumberFormat; - ADecimals: Byte = 0; ACurrencySymbol: String = ''): Integer; overload; + ANumFormat: TsNumberFormat): Integer; overload; + function AddFormat(AFormatString: String; ANumFormat: TsNumberFormat): Integer; overload; procedure AnalyzeAndAdd(AFormatIndex: Integer; AFormatString: String); procedure Clear; procedure ConvertAfterReading(AFormatIndex: Integer; var AFormatString: String; - var ANumFormat: TsNumberFormat; var ADecimals: Byte; - var ACurrencySymbol: String); virtual; + var ANumFormat: TsNumberFormat); virtual; procedure ConvertBeforeWriting(var AFormatString: String; var ANumFormat: TsNumberFormat; var ADecimals: Byte; var ACurrencySymbol: String); virtual; procedure Delete(AIndex: Integer); - function Find(ANumFormat: TsNumberFormat; AFormatString: String; - ADecimals: Byte; ACurrencySymbol: String): Integer; overload; + function Find(ANumFormat: TsNumberFormat; AFormatString: String): Integer; overload; function Find(AFormatString: String): Integer; overload; function FindByIndex(AFormatIndex: Integer): Integer; function FindByName(AFormatName: String): Integer; @@ -829,6 +878,7 @@ resourcestring lpUnknownSpreadsheetFormat = 'unknown format'; lpInvalidFontIndex = 'Invalid font index'; lpInvalidNumberFormat = 'Trying to use an incompatible number format.'; + lpInvalidDateTimeFormat = 'Trying to use an incompatible date/time format.'; lpNoValidNumberFormatString = 'No valid number format string.'; lpNoValidDateTimeFormatString = 'No valid date/time format string.'; lpNoValidCellAddress = '"%s" is not a valid cell address.'; @@ -1129,8 +1179,6 @@ begin AToCell^.TextRotation := AFromCell^.TextRotation; AToCell^.NumberFormat := AFromCell^.NumberFormat; AToCell^.NumberFormatStr := AFromCell^.NumberFormatStr; - AToCell^.Decimals := AFromCell^.Decimals; - AToCell^.CurrencySymbol := AFromCell^.CurrencySymbol; end; @@ -1321,7 +1369,6 @@ begin Result^.Col := ACol; Result^.ContentType := cctEmpty; Result^.BorderStyles := DEFAULT_BORDERSTYLES; - Result^.CurrencySymbol := '?'; Cells.Add(Result); end; @@ -1503,7 +1550,7 @@ end; function TsWorksheet.ReadAsUTF8Text(ACell: PCell): ansistring; function FloatToStrNoNaN(const Value: Double; - ANumberFormat: TsNumberFormat; ANumberFormatStr: string; ADecimals: byte): ansistring; + ANumberFormat: TsNumberFormat; ANumberFormatStr: string): ansistring; var fs: TFormatSettings; left, right: String; @@ -1513,12 +1560,12 @@ function TsWorksheet.ReadAsUTF8Text(ACell: PCell): ansistring; if IsNan(Value) then Result := '' else - if ANumberFormat = nfSci then - Result := SciFloat(Value, ADecimals) - else if (ANumberFormat = nfGeneral) or (ANumberFormatStr = '') then Result := FloatToStr(Value, fs) else + if ANumberFormat = nfSci then + Result := SciFloat(Value, CountDecs(ANumberFormatStr, ['0']), fs) + else if (ANumberFormat = nfPercentage) then Result := FormatFloat(ANumberFormatStr, Value*100, fs) else @@ -1533,7 +1580,7 @@ function TsWorksheet.ReadAsUTF8Text(ACell: PCell): ansistring; end; function DateTimeToStrNoNaN(const Value: Double; - ANumberFormat: TsNumberFormat; ANumberFormatStr: String; ADecimals: Word): ansistring; + ANumberFormat: TsNumberFormat; ANumberFormatStr: String): ansistring; var fmtp, fmtn, fmt0: String; begin @@ -1564,11 +1611,11 @@ begin with ACell^ do case ContentType of cctNumber: - Result := FloatToStrNoNaN(NumberValue, NumberFormat, NumberFormatStr, Decimals); + Result := FloatToStrNoNaN(NumberValue, NumberFormat, NumberFormatStr); cctUTF8String: Result := UTF8StringValue; cctDateTime: - Result := DateTimeToStrNoNaN(DateTimeValue, NumberFormat, NumberFormatStr, Decimals); + Result := DateTimeToStrNoNaN(DateTimeValue, NumberFormat, NumberFormatStr); cctBool: Result := IfThen(BoolValue, lpTRUE, lpFALSE); cctError: @@ -1845,33 +1892,22 @@ begin WriteNumber(GetCell(ARow, ACol), ANumber, AFormat, ADecimals, ACurrencySymbol); end; - procedure TsWorksheet.WriteNumber(ACell: PCell; ANumber: Double; AFormat: TsNumberFormat = nfGeneral; ADecimals: Byte = 2; ACurrencySymbol: String = ''); -var - fs: TFormatSettings; begin + if IsDateTimeFormat(AFormat) or IsCurrencyFormat(AFormat) then + raise Exception.Create(lpInvalidNumberFormat); + if ACell <> nil then begin ACell^.ContentType := cctNumber; ACell^.NumberValue := ANumber; - ACell^.Decimals := ADecimals; - - if IsDateTimeFormat(AFormat) then - raise Exception.Create(lpInvalidNumberFormat); - - { - if AFormat = nfCustom then - raise Exception.Create(lpIllegalNumberformat); - } if AFormat <> nfGeneral then begin Include(ACell^.UsedFormattingFields, uffNumberFormat); ACell^.NumberFormat := AFormat; - ACell^.Decimals := ADecimals; - ACell^.CurrencySymbol := ACurrencySymbol; ACell^.NumberFormatStr := BuildNumberFormatString(ACell^.NumberFormat, - Workbook.FormatSettings, ADecimals, ACurrencySymbol); + Workbook.FormatSettings, ADecimals); end else begin Exclude(ACell^.UsedFormattingFields, uffNumberFormat); ACell^.NumberFormat := nfGeneral; @@ -1888,36 +1924,41 @@ end; NOTE that fpspreadsheet may not be able to detect the formatting when reading the file. } procedure TsWorksheet.WriteNumber(ARow, ACol: Cardinal; ANumber: Double; - AFormatString: String); + AFormat: TsNumberFormat; AFormatString: String); var ACell: PCell; - parser: TsNumFormatParser; - nf: TsNumberFormat; begin - parser := TsNumFormatParser.Create(Workbook, AFormatString, nfCustom, cdToFPSpreadsheet); - try - // Format string ok? - if parser.Status <> psOK then - raise Exception.Create(lpNoValidNumberFormatString); - if IsDateTimeFormat(parser.Builtin_NumFormat) - then raise Exception.Create(lpInvalidNumberFormat); - // If format string matches a built-in format use its format identifier, - // All this is considered when calling Builtin_NumFormat of the parser. - nf := parser.Builtin_NumFormat; - finally - parser.Free; + WriteNumber(GetCell(ARow, ACol), ANumber, AFormat, AFormatString); +end; + +procedure TsWorksheet.WriteNumber(ACell: PCell; ANumber: Double; + AFormat: TsNumberFormat; AFormatString: String); +var + parser: TsNumFormatParser; +begin + if ACell <> nil then begin + parser := TsNumFormatParser.Create(Workbook, AFormatString); + try + // Format string ok? + if parser.Status <> psOK then + raise Exception.Create(lpNoValidNumberFormatString); + // Make sure that we do not write a date/time value here + if parser.IsDateTimeFormat + then raise Exception.Create(lpInvalidNumberFormat); + // If format string matches a built-in format use its format identifier, + // All this is considered when calling Builtin_NumFormat of the parser. + finally + parser.Free; + end; + + Include(ACell^.UsedFormattingFields, uffNumberFormat); + ACell^.ContentType := cctNumber; + ACell^.NumberValue := ANumber; + ACell^.NumberFormat := AFormat; //nfCustom; + ACell^.NumberFormatStr := AFormatString; + + ChangedCell(ACell^.Row, ACell^.Col); end; - - ACell := GetCell(ARow, ACol); - Include(ACell^.UsedFormattingFields, uffNumberFormat); - ACell^.ContentType := cctNumber; - ACell^.NumberValue := ANumber; - ACell^.NumberFormat := nf; - ACell^.NumberFormatStr := AFormatString; - ACell^.Decimals := 0; - ACell^.CurrencySymbol := ''; - - ChangedCell(ARow, ACol); end; {@@ @@ -1954,6 +1995,72 @@ begin ChangedCell(ARow, ACol); end; +{@@ + Writes a currency value to a given cell. Its number format can be provided + optionally by specifying these parameters: + - ADecimals: number of decimals + - APosCurrFormat: code specifying the order of value, currency symbol and spaces + (see pcfXXXX constants above) + - ANegCurrFormat: code specifying the order of value, currency symbol, spaces + and how negative values are shown (see ncfXXXX constants above) + - ACurrencySymbol: the string to be shown as currency, such as '$', or 'EUR' +} +procedure TsWorksheet.WriteCurrency(ARow, ACol: Cardinal; AValue: Double; + AFormat: TsNumberFormat = nfCurrency; ADecimals: Integer = 2; + ACurrencySymbol: String = '?'; APosCurrFormat: Integer = -1; + ANegCurrFormat: Integer = -1); +begin + WriteCurrency(GetCell(ARow, ACol), AValue, AFormat, ADecimals, ACurrencySymbol, + APosCurrFormat, ANegCurrFormat); +end; + +procedure TsWorksheet.WriteCurrency(ACell: PCell; AValue: Double; + AFormat: TsNumberFormat = nfCurrency; ADecimals: Integer = -1; + ACurrencySymbol: String = '?'; APosCurrFormat: Integer = -1; + ANegCurrFormat: Integer = -1); +var + fmt: String; +begin + if ADecimals = -1 then + ADecimals := Workbook.FormatSettings.CurrencyDecimals; + if APosCurrFormat = -1 then + APosCurrFormat := Workbook.FormatSettings.CurrencyFormat; + if ANegCurrFormat = -1 then + ANegCurrFormat := Workbook.FormatSettings.NegCurrFormat; + if ACurrencySymbol = '?' then + ACurrencySymbol := Workbook.FormatSettings.CurrencyString; + + fmt := BuildCurrencyFormatString( + Workbook.FormatSettings, + ADecimals, + APosCurrFormat, ANegCurrFormat, + AFormat in [nfCurrencyRed, nfAccountingRed], + AFormat in [nfAccounting, nfAccountingRed], + ACurrencySymbol); + + WriteCurrency(ACell, AValue, AFormat, fmt); +end; + +procedure TsWorksheet.WriteCurrency(ARow, ACol: Cardinal; AValue: Double; + AFormat: TsNumberFormat; AFormatString: String); +begin + WriteCurrency(GetCell(ARow, ACol), AValue, AFormat, AFormatString); +end; + +procedure TsWorksheet.WriteCurrency(ACell: PCell; AValue: Double; + AFormat: TsNumberFormat; AFormatString: String); +begin + if (ACell <> nil) and IsCurrencyFormat(AFormat) then begin + Include(ACell^.UsedFormattingFields, uffNumberFormat); + ACell^.ContentType := cctNumber; + ACell^.NumberValue := AValue; + ACell^.NumberFormat := AFormat; + ACell^.NumberFormatStr := AFormatString; + + ChangedCell(ACell^.Row, ACell^.Col); + end; +end; + {@@ Writes a date/time value to a determined cell @@ -1962,24 +2069,23 @@ end; @param AValue The date/time/datetime to be written @param AFormat The format specifier, e.g. nfShortDate (optional) If not specified format is not changed. - @param AFormatStr Format string, used only for nfFmtDateTime. - Must follow the rules for "FormatDateTime", or use - "dm" as abbreviation for "d/mmm", "my" for "mmm/yy", - "ms" for "nn:ss", "msz" for "nn:ss.z" (optional) - or use any other free format (at your own risk...) + @param AFormatStr Format string, used only for nfCustom or nfTimeInterval. Note: at least Excel xls does not recognize a separate datetime cell type: - a datetime is stored as a (floating point) Number, and the cell is formatted + a datetime is stored as a (floating point) number, and the cell is formatted as a date (either built-in or a custom format). } procedure TsWorksheet.WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime; - AFormat: TsNumberFormat = nfGeneral; AFormatStr: String = ''); + AFormat: TsNumberFormat = nfShortDateTime; AFormatStr: String = ''); begin WriteDateTime(GetCell(ARow, ACol), AValue, AFormat, AFormatStr); end; procedure TsWorksheet.WriteDateTime(ACell: PCell; AValue: TDateTime; - AFormat: TsNumberFormat = nfGeneral; AFormatStr: String = ''); + AFormat: TsNumberFormat = nfShortDateTime; AFormatStr: String = ''); +var + parser: TsNumFormatParser; + nf: TsNumberFormat; begin if ACell <> nil then begin ACell^.ContentType := cctDateTime; @@ -1988,9 +2094,27 @@ begin // Date/time is actually a number field in Excel. // To make sure it gets saved correctly, set a date format (instead of General). // The user can choose another date format if he wants to - if IsDateTimeFormat(AFormat) then - if (AFormat in [nfFmtDateTime, nfTimeInterval]) then - AFormatStr := BuildDateTimeFormatString(AFormat, Workbook.FormatSettings, AFormatStr); + + if AFormatStr = '' then + AFormatStr := BuildDateTimeFormatString(AFormat, Workbook.FormatSettings, AFormatStr); + + // Check whether the formatstring is for date/times. + if AFormatStr <> '' then begin + parser := TsNumFormatParser.Create(Workbook, AFormatStr); + try + // Format string ok? + if parser.Status <> psOK then + raise Exception.Create(lpNoValidNumberFormatString); + // Make sure that we do not use a number format for date/times values. + if not parser.IsDateTimeFormat + then raise Exception.Create(lpInvalidDateTimeFormat); + // Avoid possible duplication of standard formats + if AFormat = nfCustom then + AFormat := parser.NumFormat; + finally + parser.Free; + end; + end; Include(ACell^.UsedFormattingFields, uffNumberFormat); ACell^.NumberFormat := AFormat; @@ -1999,24 +2123,42 @@ begin end; end; +procedure TsWorksheet.WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime; + AFormatStr: String); +begin + WriteDateTime(GetCell(ARow, ACol), AValue, AFormatStr); +end; + +procedure TsWorksheet.WriteDateTime(ACell: PCell; AValue: TDateTime; + AFormatStr: String); +begin + WriteDateTime(ACell, AValue, nfCustom, AFormatStr); +end; + procedure TsWorksheet.WriteDecimals(ARow, ACol: Cardinal; ADecimals: Byte); begin WriteDecimals(FindCell(ARow, ACol), ADecimals); end; procedure TsWorksheet.WriteDecimals(ACell: PCell; ADecimals: Byte); +var + parser: TsNumFormatParser; begin if (ACell <> nil) and (ACell^.ContentType = cctNumber) and (ACell^.NumberFormat <> nfCustom) then begin - ACell^.Decimals := ADecimals; - ACell^.NumberFormatStr := BuildNumberFormatString(ACell^.NumberFormat, - FWorkbook.FormatSettings, ADecimals, ACell^.CurrencySymbol); + parser := TsNumFormatParser.Create(Workbook, ACell^.NumberFormatStr); + try + parser.Decimals := ADecimals; + ACell^.NumberFormatStr := parser.FormatString[nfdDefault]; + finally + parser.Free; + end; ChangedCell(ACell^.Row, ACell^.Col); end; end; {@@ - Writes a cell with an error. + Writes a cell with an error value. @param ARow The row of the cell @param ACol The column of the cell @@ -2037,7 +2179,7 @@ begin end; {@@ - Writes a formula to a determined cell + Writes a formula to a given cell @param ARow The row of the cell @param ACol The column of the cell @@ -2080,8 +2222,7 @@ begin Include(ACell^.UsedFormattingFields, uffNumberFormat); ACell^.NumberFormat := ANumberFormat; if (AFormatString = '') then - ACell^.NumberFormatStr := BuildNumberFormatString(ANumberFormat, - Workbook.FormatSettings, ACell^.Decimals, ACell^.CurrencySymbol) + ACell^.NumberFormatStr := BuildNumberFormatString(ANumberFormat, Workbook.FormatSettings) else ACell^.NumberFormatStr := AFormatString; ChangedCell(ACell^.Row, ACell^.Col); @@ -2521,6 +2662,8 @@ begin FDefaultColWidth := 12; FDefaultRowHeight := 1; FormatSettings := DefaultFormatSettings; + FormatSettings.ShortDateFormat := MakeShortDateFormat(FormatSettings.ShortDateFormat); + FormatSettings.LongDateFormat := MakeLongDateFormat(FormatSettings.ShortDateFormat); FFontList := TFPList.Create; SetDefaultFont('Arial', 10.0); InitFonts; @@ -3194,8 +3337,7 @@ end; { Adds a new number format data to the list and returns the list index of the new item. } function TsCustomNumFormatList.AddFormat(AFormatIndex: Integer; - AFormatName, AFormatString: String; ANumFormat: TsNumberFormat; - ADecimals: Byte = 0; ACurrencySymbol: String = ''): Integer; + AFormatName, AFormatString: String; ANumFormat: TsNumberFormat): Integer; var item: TsNumFormatData; begin @@ -3203,45 +3345,31 @@ begin item.Index := AFormatIndex; item.Name := AFormatName; item.NumFormat := ANumFormat; - if AFormatString = '' then begin - if IsDateTimeFormat(ANumFormat) then - AFormatString := BuildDateTimeFormatString(ANumFormat, Workbook.FormatSettings, - AFormatString) - else - AFormatString := BuildNumberFormatString(ANumFormat, Workbook.FormatSettings, - ADecimals, ACurrencySymbol); - end; item.FormatString := AFormatString; - item.Decimals := ADecimals; - item.CurrencySymbol := ACurrencySymbol; Result := inherited Add(item); end; function TsCustomNumFormatList.AddFormat(AFormatIndex: Integer; - AFormatString: String; ANumFormat: TsNumberFormat; ADecimals: byte = 0; - ACurrencySymbol: String = ''): integer; + AFormatString: String; ANumFormat: TsNumberFormat): integer; begin - Result := AddFormat(AFormatIndex, '', AFormatString, ANumFormat, ADecimals, ACurrencySymbol); + Result := AddFormat(AFormatIndex, '', AFormatString, ANumFormat); end; function TsCustomNumFormatList.AddFormat(AFormatName, AFormatString: String; - ANumFormat: TsNumberFormat; ADecimals: Byte = 0; - ACurrencySymbol: String = ''): Integer; + ANumFormat: TsNumberFormat): Integer; begin if (AFormatString = '') and (ANumFormat <> nfGeneral) then begin Result := 0; exit; end; - Result := AddFormat(FNextFormatIndex, AFormatName, AFormatString, ANumFormat, - ADecimals, ACurrencySymbol); + Result := AddFormat(FNextFormatIndex, AFormatName, AFormatString, ANumFormat); inc(FNextFormatIndex); end; function TsCustomNumFormatList.AddFormat(AFormatString: String; - ANumFormat: TsNumberFormat; ADecimals: Byte = 0; - ACurrencySymbol: String = ''): Integer; + ANumFormat: TsNumberFormat): Integer; begin - Result := AddFormat('', AFormatString, ANumFormat, ADecimals, ACurrencySymbol); + Result := AddFormat('', AFormatString, ANumFormat); end; function TsCustomNumFormatList.AddFormat(AFormatCell: PCell): Integer; @@ -3256,9 +3384,7 @@ begin Result := AddFormat(FNextFormatIndex, AFormatCell^.NumberFormatStr, - AFormatCell^.NumberFormat, - AFormatCell^.Decimals, - AFormatCell^.CurrencySymbol + AFormatCell^.NumberFormat ); inc(FNextFormatIndex); @@ -3283,8 +3409,7 @@ end; overridden method which known more about the details of the spreadsheet file format. } procedure TsCustomNumFormatList.ConvertAfterReading(AFormatIndex: Integer; - var AFormatString: String; var ANumFormat: TsNumberFormat; - var ADecimals: Byte; var ACurrencySymbol: String); + var AFormatString: String; var ANumFormat: TsNumberFormat); var parser: TsNumFormatParser; fmt: String; @@ -3302,44 +3427,27 @@ begin nf := nfGeneral; // Analyzes the format string and tries to convert it to fpSpreadsheet format. - parser := TsNumFormatParser.Create(Workbook, fmt, nf, cdToFPSpreadsheet); + parser := TsNumFormatParser.Create(Workbook, fmt); //, nf, cdToFPSpreadsheet); try if parser.Status = psOK then begin - ANumFormat := parser.Builtin_NumFormat; - AFormatString := parser.FormatString; // This is the converted string. - if ANumFormat <> nfCustom then begin - ADecimals := parser.ParsedSections[0].Decimals; - ACurrencySymbol := parser.ParsedSections[0].CurrencySymbol; - end else begin - ADecimals := 0; - ACurrencySymbol := ''; - end; + ANumFormat := parser.NumFormat; + AFormatString := parser.FormatString[nfdDefault]; + end else begin + // Show an error here? end; finally parser.Free; end; end; -{ Is called before collection all number formats of the spreadsheet and before +{ Is called before collecting all number formats of the spreadsheet and before writing to file. Its purpose is to convert the format string as used by fpc - to a format compatible with the spreadsheet file format. } + to a format compatible with the spreadsheet file format. + Nothing is changed here. The method needs to be overridden. } procedure TsCustomNumFormatList.ConvertBeforeWriting(var AFormatString: String; var ANumFormat: TsNumberFormat; var ADecimals: Byte; var ACurrencySymbol: String); -var - parser: TsNumFormatParser; - fmt: String; begin - parser := TsNumFormatParser.Create(Workbook, AFormatString, ANumFormat, cdFromFPSpreadsheet); - try - if parser.Status = psOK then begin - AFormatString := parser.FormatString; - ANumFormat := parser.Builtin_NumFormat; - ADecimals := parser.ParsedSections[0].Decimals; - ACurrencySymbol := parser.ParsedSections[0].CurrencySymbol; - end; - finally - parser.Free; - end; + // nothing to do here. But see, e.g., xlscommon.TsBIFFNumFormatList end; { Called from the reader when a format item has been read from the file. @@ -3357,10 +3465,10 @@ begin exit; // Analyze & convert the format string, extract infos for internal formatting - ConvertAfterReading(AFormatIndex, AFormatString, nf, decs, currsym); + ConvertAfterReading(AFormatIndex, AFormatString, nf); // Add the new item - AddFormat(AFormatIndex, AFormatString, nf, decs, currSym); + AddFormat(AFormatIndex, AFormatString, nf); end; { Clears the list and frees memory occupied by the format items. } @@ -3383,65 +3491,14 @@ end; { Seeks a format item with the given properties and returns its list index, or -1 if not found. } function TsCustomNumFormatList.Find(ANumFormat: TsNumberFormat; - AFormatString: String; ADecimals: Byte; ACurrencySymbol: String): Integer; + AFormatString: String): Integer; var item: TsNumFormatData; - fmt: String; - itemfmt: String; begin - if (ANumFormat = nfFmtDateTime) then begin - fmt := lowercase(AFormatString); - for Result := Count-1 downto 0 do begin - item := Items[Result]; - if (item <> nil) and (item.NumFormat = nfFmtDateTime) then begin - itemfmt := lowercase(item.FormatString); - if ((itemfmt = 'dm') or (itemfmt = 'd-mmm') or (itemfmt = 'd mmm') or (itemfmt = 'd. mmm') or (itemfmt ='d/mmm')) - and ((fmt = 'dm') or (fmt = 'd-mmm') or (fmt = 'd mmm') or (fmt = 'd. mmm') or (fmt = 'd/mmm')) - then - exit; - if ((itemfmt = 'my') or (itemfmt = 'mmm-yy') or (itemfmt = 'mmm yyy') or (itemfmt = 'mmm/yy')) - and ((fmt = 'my') or (fmt = 'mmm-yy') or (fmt = 'mmm yy') or (fmt = 'mmm/yy')) - then - exit; - if ((itemfmt = 'ms') or (itemfmt = 'nn:ss') or (itemfmt = 'mm:ss')) - and ((fmt = 'ms') or (fmt = 'nn:ss') or (fmt = 'mm:ss')) - then - exit; - if ((itemfmt = 'msz') or (itemfmt = 'mm:ss.z') or (itemfmt = 'mm:ss.0')) - and ((fmt = 'msz') or (fmt = 'mm:ss.z') or (fmt = 'mm:ss.0')) - then - exit; - end; - end; - for Result := 0 to Count-1 do begin - item := Items[Result]; - if fmt = lowercase(item.FormatString) then - exit; - end; - end; - - // Check only the format string for nfCustom. - if (ANumFormat = nfCustom) then - 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; - - // The other formats can carry additional information for Result := Count-1 downto 0 do begin item := Items[Result]; - if (item <> nil) - and (item.NumFormat = ANumFormat) - and (item.FormatString = AFormatString) - and (item.Decimals = ADecimals) - and (not (item.NumFormat in [nfCurrency, nfCurrencyRed, nfAccounting, nfAccountingRed]) - or (item.CurrencySymbol = ACurrencySymbol)) - then - exit; + if (item <> nil) and (item.NumFormat = ANumFormat) and (item.FormatString = AFormatString) + then exit; end; Result := -1; end; @@ -3499,19 +3556,25 @@ begin if AFormatCell = nil then Result := -1 else - Result := Find(AFormatCell^.NumberFormat, AFormatCell^.NumberFormatStr, - AFormatCell^.Decimals, AFormatCell^.CurrencySymbol); + Result := Find(AFormatCell^.NumberFormat, AFormatCell^.NumberFormatStr); end; -{ Determines the format string to be written into the spreadsheet file. - Needs to be overridden if the format strings are different from the fpc - convention. } +{ 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. } function TsCustomNumFormatList.FormatStringForWriting(AIndex: Integer): String; var item: TsNumFormatdata; + nf: TsNumberFormat; + decs: Byte; + cs: String; begin item := Items[AIndex]; - if item <> nil then Result := item.FormatString else Result := ''; + if item <> nil then begin + Result := item.FormatString; + ConvertBeforeWriting(Result, nf, decs, cs); + end else + Result := ''; end; function TsCustomNumFormatList.GetItem(AIndex: Integer): TsNumFormatData; @@ -3641,14 +3704,14 @@ end; } function TsCustomSpreadWriter.FindFormattingInList(AFormat: PCell): Integer; var - i: Integer; + i, n: Integer; b: TsCellBorder; equ: Boolean; begin Result := -1; - for i := Length(FFormattingStyles) - 1 downto 0 do - begin + n := Length(FFormattingStyles); + for i := n - 1 downto 0 do begin if (FFormattingStyles[i].UsedFormattingFields <> AFormat^.UsedFormattingFields) then Continue; if uffHorAlign in AFormat^.UsedFormattingFields then @@ -3683,18 +3746,7 @@ begin if uffNumberFormat in AFormat^.UsedFormattingFields then begin if (FFormattingStyles[i].NumberFormat <> AFormat^.NumberFormat) then Continue; - case AFormat^.NumberFormat of - nfFixed, nfFixedTh, nfPercentage, nfExp, nfSci: - if (FFormattingStyles[i].Decimals <> AFormat^.Decimals) then Continue; - nfCurrency, nfCurrencyRed, nfAccounting, nfAccountingRed: - begin - if (FFormattingStyles[i].Decimals <> AFormat^.Decimals) then Continue; - if (FFormattingStyles[i].CurrencySymbol <> AFormat^.CurrencySymbol) then Continue; - end; - nfShortDateTime, nfShortDate, nfLongDate, nfShortTime, nfLongTime, - nfShortTimeAM, nfLongTimeAM, nfFmtDateTime, nfTimeInterval, nfCustom: - if (FFormattingstyles[i].NumberFormatStr <> AFormat^.NumberFormatStr) then Continue; - end; + if (FFormattingStyles[i].NumberFormatStr <> AFormat^.NumberFormatStr) then Continue; end; if uffFont in AFormat^.UsedFormattingFields then @@ -3740,23 +3792,6 @@ begin SetLength(FFormattingStyles, Len+1); FFormattingStyles[Len] := ACell^; - // Some built-in number formats do not write the format string to the cell - // But the FormattingStyles need it for comparison later. --> Add the format string. - if IsDateTimeFormat(FFormattingStyles[Len].NumberFormat) then - FFormattingStyles[Len].NumberFormatStr := BuildDateTimeFormatString( - FFormattingStyles[Len].NumberFormat, - Workbook.FormatSettings, - FFormattingStyles[Len].NumberFormatStr - ) - else - if FFormattingStyles[Len].NumberFormat <> nfCustom then - FFormattingstyles[Len].NumberFormatStr := BuildNumberFormatString( - FFormattingStyles[Len].NumberFormat, - Workbook.FormatSettings, - FFormattingStyles[Len].Decimals, - FFormattingStyles[Len].CurrencySymbol - ); - // We store the index of the XF record that will be assigned to this style in // the "row" of the style. Will be needed when writing the XF record. FFormattingStyles[Len].Row := NextXFIndex; @@ -3776,6 +3811,7 @@ begin for i := 0 to Workbook.GetWorksheetCount - 1 do IterateThroughCells(nil, Workbook.GetWorksheetByIndex(i).Cells, ListAllFormattingStylesCallback); + (* // Convert the numberformats of the collected styles to be compatible with the destination file for i:=0 to High(FFormattingStyles) do if (FFormattingStyles[i].NumberFormatStr <> '') and @@ -3787,6 +3823,7 @@ begin FFormattingStyles[i].Decimals, FFormattingStyles[i].CurrencySymbol ); + *) end; {@@ @@ -3797,37 +3834,25 @@ procedure TsCustomSpreadWriter.ListAllNumFormatsCallback(ACell: PCell; AStream: var fmt: string; nf: TsNumberFormat; - decs: Byte; - cs: String; begin if ACell^.NumberFormat = nfGeneral then exit; - // The builtin format list is in "file syntax", but the format string of the - // cells are in "fpc syntax". Therefore, before seeking, we have to convert - // the format string of the cell to "file syntax". + // The builtin format list is in fpc dialect. fmt := ACell^.NumberFormatStr; nf := ACell^.NumberFormat; - decs := ACell^.Decimals; - cs := ACell^.CurrencySymbol; - if (nf <> nfCustom) then begin - if IsDateTimeFormat(nf) then - fmt := BuildDateTimeFormatString(nf, Workbook.FormatSettings, fmt) - else - fmt := BuildNumberFormatString(nf, Workbook.FormatSettings, decs, cs); - FNumFormatList.ConvertBeforeWriting(fmt, nf, decs, cs); - end; // Seek the format string in the current number format list. // If not found add the format to the list. - if FNumFormatList.Find(fmt) = -1 then - FNumFormatList.AddFormat(fmt, nf, decs, cs); + if FNumFormatList.Find(nf, fmt) = -1 then + FNumFormatList.AddFormat(fmt, nf); end; {@@ - Iterats through all cells and collects the number formats in + 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. } + 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; diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index a152dd559..15afa8a39 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -70,22 +70,23 @@ function IfThen(ACondition: Boolean; AValue1,AValue2: TsNumberFormat): TsNumberF function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean; function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; overload; -function IsDateTimeFormat(AFormatStr: String): Boolean; overload; +//function IsDateTimeFormat(AFormatStr: String): Boolean; overload; -function BuildNumberFormatString(ANumberFormat: TsNumberFormat; - const AFormatSettings: TFormatSettings; ADecimals: Integer = -1; - ACurrencySymbol: String = '?'): String; +function BuildCurrencyFormatString(const AFormatSettings: TFormatSettings; + ADecimals, APosCurrFormat, ANegCurrFormat: Integer; + ANegativeValuesRed, AAccountingStyle: Boolean; ACurrencySymbol: String = '?'): String; function BuildDateTimeFormatString(ANumberFormat: TsNumberFormat; const AFormatSettings: TFormatSettings; AFormatString: String = ''): String; -function BuildCurrencyFormatString(const AFormatSettings: TFormatSettings; - ADecimals: Integer; ANegativeValuesRed: Boolean; AAccountingStyle: Boolean; - ACurrencySymbol: String = '?'): String; +function BuildNumberFormatString(ANumberFormat: TsNumberFormat; + const AFormatSettings: TFormatSettings; ADecimals: Integer = -1): String; function AddAMPM(const ATimeFormatString: String; const AFormatSettings: TFormatSettings): String; function StripAMPM(const ATimeFormatString: String): String; function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte; function AddIntervalBrackets(AFormatString: String): String; +function MakeLongDateFormat(AShortDateFormat: String): String; +function MakeShortDateFormat(AShortDateFormat: String): String; function SpecialDateTimeFormat(ACode: String; const AFormatSettings: TFormatSettings; ForWriting: Boolean): String; function SplitAccountingFormatString(const AFormatString: String; ASection: ShortInt; @@ -93,7 +94,8 @@ function SplitAccountingFormatString(const AFormatString: String; ASection: Shor procedure SplitFormatString(const AFormatString: String; out APositivePart, ANegativePart, AZeroPart: String); -function SciFloat(AValue: Double; ADecimals: Byte): String; +function SciFloat(AValue: Double; ADecimals: Byte): String; overload; +function SciFloat(AValue: Double; ADecimals: Byte; AFormatSettings: TFormatSettings): String; overload; //function TimeIntervalToString(AValue: TDateTime; AFormatStr: String): String; procedure MakeTimeIntervalMask(Src: String; var Dest: String); @@ -563,53 +565,10 @@ end; { Checks whether the given number format code is for date/times. } function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; begin - Result := AFormat in [nfFmtDateTime, nfShortDateTime, nfShortDate, nfLongDate, + Result := AFormat in [{nfFmtDateTime, }nfShortDateTime, nfShortDate, nfLongDate, nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, nfTimeInterval]; end; -function IsDateTimeFormat(AFormatStr: string): Boolean; -var - P, PStart, PEnd: PChar; - token: Char; -begin - if AFormatStr = '' then - Result := false - else begin - PStart := PChar(@AFormatStr[1]); - PEnd := PStart + Length(AFormatStr); - P := PStart; - while P < PEnd do begin - token := P^; - case token of // Skip quoted text - '"': begin - inc(P); - token := P^; - while (P < PEnd) and (token <> '"') do begin - inc(P); - token := P^; - end; - end; - { - '[': begin - inc(P); - token := P^; - while (P < PEnd) and (token <> ']') do begin - inc(P); - token := P^; - end; - end; - } - 'y', 'Y', 'm', 'M', 'd', 'D', 'h', 'H', 'n', 'N', 's', 'S', ':': - begin - Result := true; - exit; - end; - end; - inc(P); - end; - end; -end; - { Builds a date/time format string from the numberformat code. If the format code is nfFmtDateTime the given AFormatString is used. AFormatString can use the abbreviations "dm" (for "d/mmm"), "my" (for "mmm/yy"), "ms" (for "mm:ss") @@ -620,8 +579,10 @@ var fmt: String; begin case ANumberFormat of + { nfFmtDateTime: Result := SpecialDateTimeFormat(lowercase(AFormatString), AFormatSettings, false); + } nfShortDateTime: Result := AFormatSettings.ShortDateFormat + ' ' + AFormatSettings.ShortTimeFormat; // In the DefaultFormatSettings this is: d/m/y hh:nn @@ -664,41 +625,44 @@ end; This code has to be removed by StripAccountingSymbols before applying to FormatFloat. } function BuildCurrencyFormatString(const AFormatSettings: TFormatSettings; - ADecimals: Integer; ANegativeValuesRed: Boolean; AAccountingStyle: Boolean; - ACurrencySymbol: String = '?'): String; + ADecimals, APosCurrFormat, ANegCurrFormat: Integer; ANegativeValuesRed: Boolean; + AAccountingStyle: Boolean; ACurrencySymbol: String = '?'): String; const - POS_FMT: array[0..3, boolean] of string = ( //0: value, 1: currency symbol + POS_FMT: array[0..3, boolean] of string = ( + // Parameter 0 is "value", parameter 1 is "currency symbol" + // AccountingStyle = false --> 1st column, true --> 2nd column ('"%1:s"%0:s', '"%1:s"* %0:s'), // 0: $1 - ('%0:s"%1:s"', '%0:s* "%1:s"'), // 1: 1$ + ('%0:s"%1:s"', '%0:s "%1:s"'), // 1: 1$ ('"%1:s" %0:s', '"%1:s"* %0:s'), // 2: $ 1 - ('%0:s "%1:s"', '%0:s* "%1:s"') // 3: 1 $ + ('%0:s "%1:s"', '%0:s "%1:s"') // 3: 1 $ ); NEG_FMT: array[0..15, boolean] of string = ( ('("%1:s"%0:s)', '"%1:s"* (%0:s)'), // 0: ($1) - ('-"%1:s"%0:s', '"%1:s"* -%0:s'), // 1: -$1 + ('-"%1:s"%0:s', '-* "%1:s" %0:s'), // 1: -$1 ('"%1:s"-%0:s', '"%1:s"* -%0:s'), // 2: $-1 - ('"%1:s"%0:s-', '"%1:s"* %0:s-'), // 3: $1- - ('(%0:s"%1:s")', '(%0:s)"%1:s"'), // 4: (1$) - ('-%0:s"%1:s"', '-%0:s"%1:s"'), // 5: -1$ + ('"%1:s"%0:s-', '"%1:s"%0:s-'), // 3: $1- + ('(%0:s"%1:s")', '(%0:s)%1:s"'), // 4: (1$) + ('-%0:s"%1:s"', '-* %0:s"%1:s"'), // 5: -1$ ('%0:s-"%1:s"', '%0:s-"%1:s"'), // 6: 1-$ ('%0:s"%1:s"-', '%0:s-"%1:s"'), // 7: 1$- - ('-%0:s "%1:s"', '-%0:s"%1:s"'), // 8: -1 $ - ('-"%1:s" %0:s', '"%1:s"* -%0:s'), // 9: -$ 1 + ('-%0:s "%1:s"', '-* %0:s"%1:s"'), // 8: -1 $ + ('-"%1:s" %0:s', '-* "%1:s" -%0:s'), // 9: -$ 1 ('%0:s "%1:s"-', '%0:s- "%1:s"'), // 10: 1 $- ('"%1:s" %0:s-', '"%1:s"* %0:s-'), // 11: $ 1- ('"%1:s" -%0:s', '"%1:s"* -%0:s'), // 12: $ -1 ('%0:s- "%1:s"', '%0:s- "%1:s"'), // 13: 1- $ ('("%1:s" %0:s)', '"%1:s"* (%0:s)'), // 14: ($ 1) - ('(%0:s "%1:s")', '(%0:s) "%1:s"') // 15: (1 $) + ('(%0:s "%1:s")', '(%0:s "%1:s")') // 15: (1 $) ); var decs: String; cf, ncf: Byte; p, n: String; begin - cf := AFormatSettings.CurrencyFormat; - ncf := AFormatSettings.NegCurrFormat; - if ADecimals < 0 then ADecimals := AFormatSettings.CurrencyDecimals; + cf := IfThen(APosCurrFormat < 0, AFormatSettings.CurrencyFormat, APosCurrFormat); + ncf := IfThen(ANegCurrFormat < 0, AFormatSettings.NegCurrFormat, ANegCurrFormat); + if ADecimals < 0 then + ADecimals := AFormatSettings.CurrencyDecimals; if ACurrencySymbol = '?' then ACurrencySymbol := AnsiToUTF8(AFormatSettings.CurrencyString); decs := DupeString('0', ADecimals); @@ -717,7 +681,7 @@ begin if ACurrencySymbol <> '' then begin Result := Format(p, ['#,##0' + decs, ACurrencySymbol]) + ';' - + Format(n, ['#,##0' + decs, ACurrencySymbol]) + ';' + + IfThen(ANegativeValuesRed, '[red]', '') + Format(n, ['#,##0' + decs, ACurrencySymbol]) + ';' + Format(p, [IfThen(AAccountingStyle, '-', '0'+decs), ACurrencySymbol]); end else begin @@ -731,21 +695,16 @@ begin end; end; -{ Builds a number format string from the numberformat code, the count of +{ Builds a number format string from the number format code, the count of decimals, and the currencysymbol (if not empty). } function BuildNumberFormatString(ANumberFormat: TsNumberFormat; - const AFormatSettings: TFormatSettings; ADecimals: Integer = -1; - ACurrencySymbol: String = '?'): String; + const AFormatSettings: TFormatSettings; ADecimals: Integer = -1): String; var decs: String; - cf, ncf: Byte; begin Result := ''; - cf := AFormatSettings.CurrencyFormat; - ncf := AFormatSettings.NegCurrFormat; - if ADecimals = -1 then ADecimals := AFormatSettings.CurrencyDecimals; - if ACurrencySymbol = '?' then - ACurrencySymbol := AnsiToUTF8(AFormatSettings.CurrencyString); + if ADecimals = -1 then + ADecimals := AFormatSettings.CurrencyDecimals; decs := DupeString('0', ADecimals); if ADecimals > 0 then decs := '.' + decs; case ANumberFormat of @@ -760,13 +719,12 @@ begin nfPercentage: Result := '0' + decs + '%'; nfCurrency, nfCurrencyRed, nfAccounting, nfAccountingRed: - Result := BuildCurrencyFormatString( - AFormatSettings, - ADecimals, - ANumberFormat in [nfCurrencyRed, nfAccountingRed], - ANumberFormat in [nfAccounting, nfAccountingRed], - ACurrencySymbol - ); + raise Exception.Create('BuildNumberFormatString: Use BuildCurrencyFormatString '+ + 'to create a format string for currency values.'); + nfShortDateTime, nfShortDate, nfLongDate, nfShortTime, nfLongTime, + nfShortTimeAM, nfLongTimeAM, nfTimeInterval: + raise Exception.Create('BuildNumberFormatString: Use BuildDateTimeFormatSstring '+ + 'to create a format string for date/time values.'); end; end; @@ -802,12 +760,18 @@ var i: Integer; begin Result := 0; - for i:=Length(AFormatString) downto 1 do begin - if AFormatString[i] in ADecChars then inc(Result); - if AFormatString[i] = '.' then exit; + i := 1; + while (i <= Length(AFormatString)) do begin + if AFormatString[i] = '.' then begin + inc(i); + while (i <= Length(AFormatString)) and (AFormatString[i] in ADecChars) do begin + inc(i); + inc(Result); + end; + exit; + end else + inc(i); end; - // Comes to this point when there is no decimal separtor. - Result := 0; end; { The given format string is assumed to be for time intervals, i.e. its first @@ -831,6 +795,64 @@ begin end; end; +{ Creates a long date format string out of a short one. Retains the order of + year-month-day and the separators, but uses 4 digits for year and 3 digits of m } +function MakeLongDateFormat(AShortDateFormat: String): String; +var + i: Integer; +begin + Result := ''; + i := 1; + while i < Length(AShortDateFormat) do begin + case AShortDateFormat[i] of + 'y', 'Y': + begin + Result := Result + DupeString(AShortDateFormat[i], 4); + while (i < Length(AShortDateFormat)) and (AShortDateFormat[i] in ['y','Y']) do + inc(i); + end; + 'm', 'M': + begin + result := Result + DupeString(AShortDateFormat[i], 3); + while (i < Length(AShortDateFormat)) and (AShortDateFormat[i] in ['m','M']) do + inc(i); + end; + else + Result := Result + AShortDateFormat[i]; + inc(i); + end; + end; +end; + +{ Modifies the short date format such that it has a two-digit year and a two-digit + month. Retains the order of year-month-day and the separators. } +function MakeShortDateFormat(AShortDateFormat: String): String; +var + i: Integer; +begin + Result := ''; + i := 1; + while i < Length(AShortDateFormat) do begin + case AShortDateFormat[i] of + 'y', 'Y': + begin + Result := Result + DupeString(AShortDateFormat[i], 2); + while (i < Length(AShortDateFormat)) and (AShortDateFormat[i] in ['y','Y']) do + inc(i); + end; + 'm', 'M': + begin + result := Result + DupeString(AShortDateFormat[i], 2); + while (i < Length(AShortDateFormat)) and (AShortDateFormat[i] in ['m','M']) do + inc(i); + end; + else + Result := Result + AShortDateFormat[i]; + inc(i); + end; + end; +end; + { Creates the formatstrings for the date/time codes "dm", "my", "ms" and "msz" out of the formatsettings. } function SpecialDateTimeFormat(ACode: String; @@ -862,7 +884,7 @@ begin Result := DupeString(MinuteChar, 2) + ':ss'; // mm:ss end else if ACode = 'msz' then - Result := DupeString(MinuteChar, 2) + ':ss.' + MillisecChar // mm:ss.z + Result := DupeString(MinuteChar, 2) + ':ss.' + MillisecChar // mm:ss.z else Result := ACode; end; @@ -991,23 +1013,30 @@ end; { Formats the number AValue in "scientific" format with the given number of decimals. "Scientific" is the same as "exponential", but with exponents rounded to multiples of 3 (like for "kilo" - "Mega" - "Giga" etc.). } -function SciFloat(AValue: Double; ADecimals: Byte): String; +function SciFloat(AValue: Double; ADecimals: Byte; + AFormatSettings: TFormatSettings): String; var m: Double; ex: Integer; begin if AValue = 0 then - Result := '0.0' + Result := Format('%0.*fE+0', [ADecimals, 0.0], AFormatSettings) + // Excel shows "000.0E+0", but I think the "0.0E+0" shown here is better. else begin ex := floor(log10(abs(AValue))); // exponent // round exponent to multiples of 3 ex := (ex div 3) * 3; if ex < 0 then dec(ex, 3); m := AValue * Power(10, -ex); // mantisse - Result := Format('%.*fE%d', [ADecimals, m, ex]); + Result := Format('%.*fE+%d', [ADecimals, m, ex], AFormatSettings); end; end; +function SciFloat(AValue: Double; ADecimals: Byte): String; +begin + Result := SciFloat(AValue, ADecimals, DefaultFormatSettings); +end; + { Creates a "time interval" format string having the first code identifier in square brackets. } procedure MakeTimeIntervalMask(Src: String; var Dest: String); diff --git a/components/fpspreadsheet/tests/datetests.pas b/components/fpspreadsheet/tests/datetests.pas index ca9ff1784..5ac7e06c4 100644 --- a/components/fpspreadsheet/tests/datetests.pas +++ b/components/fpspreadsheet/tests/datetests.pas @@ -250,27 +250,27 @@ begin SollDates[14]:=SollDates[1]; // #1 formatted as nfLongTime SollDates[15]:=SollDates[1]; // #1 formatted as nfShortTimeAM SollDates[16]:=SollDates[1]; // #1 formatted as nfLongTimeAM - SollDates[17]:=SollDates[1]; // #1 formatted as nfFmtDateTime dm - SollDates[18]:=SollDates[1]; // #1 formatted as nfFmtDateTime my - SollDates[19]:=SollDates[1]; // #1 formatted as nfFmtDateTime ms + SollDates[17]:=SollDates[1]; // #1 formatted as nfCustom dd/mmm + SollDates[18]:=SollDates[1]; // #1 formatted as nfCustom mmm/yy + SollDates[19]:=SollDates[1]; // #1 formatted as nfCustom mm:ss SollDates[20]:=SollDates[5]; // #5 formatted as nfShortDateTime SollDates[21]:=SollDates[5]; // #5 formatted as nfShortTime SollDates[22]:=SollDates[5]; // #5 formatted as nfLongTime SollDates[23]:=SollDates[5]; // #5 formatted as nfShortTimeAM SollDates[24]:=SollDates[5]; // #5 formatted as nfLongTimeAM - SollDates[25]:=SollDates[5]; // #5 formatted as nfFmtDateTime dm - SollDates[26]:=SollDates[5]; // #5 formatted as nfFmtDateTime my - SollDates[27]:=SollDates[5]; // #5 formatted as nfFmtDateTime ms + SollDates[25]:=SollDates[5]; // #5 formatted as nfCustom dd:mmm + SollDates[26]:=SollDates[5]; // #5 formatted as nfCustom mmm:yy + SollDates[27]:=SollDates[5]; // #5 formatted as nfCustom mm:ss SollDates[28]:=SollDates[11]; // #11 formatted as nfShortDateTime SollDates[29]:=SollDates[11]; // #11 formatted as nfShortTime SollDates[30]:=SollDates[11]; // #11 formatted as nfLongTime SollDates[31]:=SollDates[11]; // #11 formatted as nfShortTimeAM SollDates[32]:=SollDates[11]; // #11 formatted as nfLongTimeAM - SollDates[33]:=SollDates[11]; // #11 formatted as nfFmtDateTime dm - SollDates[34]:=SollDates[11]; // #11 formatted as nfFmtDateTime my - SollDates[35]:=SollDates[11]; // #11 formatted as nfFmtDateTime ms + SollDates[33]:=SollDates[11]; // #11 formatted as nfCustom dd/mmm + SollDates[34]:=SollDates[11]; // #11 formatted as nfCustom mmm/yy + SollDates[35]:=SollDates[11]; // #11 formatted as nfCustom mmm:ss SollDates[36]:=EncodeTime(3,45,12,0); // formatted as nfTimeDuration SollDates[37]:=EncodeTime(3,45,12,0) + 1 // formatted as nfTimeDuration diff --git a/components/fpspreadsheet/tests/formattests.pas b/components/fpspreadsheet/tests/formattests.pas index 82402d6a7..d80a78a1f 100644 --- a/components/fpspreadsheet/tests/formattests.pas +++ b/components/fpspreadsheet/tests/formattests.pas @@ -137,10 +137,15 @@ procedure InitSollFmtData; var i: Integer; fs: TFormatSettings; + myworkbook: TsWorkbook; begin // Set up norm - MUST match spreadsheet cells exactly - fs := DefaultFormatSettings; + // The workbook uses a slightly modified copy of the DefaultFormatSettings + // We create a copy here in order to better define the predicted strings. + myWorkbook := TsWorkbook.Create; + fs := MyWorkbook.FormatSettings; + myWorkbook.Free; // Numbers SollNumbers[0] := 0.0; @@ -162,15 +167,15 @@ begin SollNumberFormats[8] := nfSci; SollNumberDecimals[8] := 1; for i:=Low(SollNumbers) to High(SollNumbers) do begin - SollNumberStrings[i, 0] := FloatToStr(SollNumbers[i]); - SollNumberStrings[i, 1] := FormatFloat('0', SollNumbers[i]); - SollNumberStrings[i, 2] := FormatFloat('0.00', SollNumbers[i]); - SollNumberStrings[i, 3] := FormatFloat('#,##0', SollNumbers[i]); - SollNumberStrings[i, 4] := FormatFloat('#,##0.00', SollNumbers[i]); - SollNumberStrings[i, 5] := FormatFloat('0.00E+00', SollNumbers[i]); - SollNumberStrings[i, 6] := FormatFloat('0', SollNumbers[i]*100) + '%'; - SollNumberStrings[i, 7] := FormatFloat('0.00', SollNumbers[i]*100) + '%'; - SollNumberStrings[i, 8] := SciFloat(SollNumbers[i], 1); + SollNumberStrings[i, 0] := FloatToStr(SollNumbers[i], fs); + SollNumberStrings[i, 1] := FormatFloat('0', SollNumbers[i], fs); + SollNumberStrings[i, 2] := FormatFloat('0.00', SollNumbers[i], fs); + SollNumberStrings[i, 3] := FormatFloat('#,##0', SollNumbers[i], fs); + SollNumberStrings[i, 4] := FormatFloat('#,##0.00', SollNumbers[i], fs); + SollNumberStrings[i, 5] := FormatFloat('0.00E+00', SollNumbers[i], fs); + SollNumberStrings[i, 6] := FormatFloat('0', SollNumbers[i]*100, fs) + '%'; + SollNumberStrings[i, 7] := FormatFloat('0.00', SollNumbers[i]*100, fs) + '%'; + SollNumberStrings[i, 8] := SciFloat(SollNumbers[i], 1, fs); end; // Date/time values @@ -186,22 +191,22 @@ begin SollDateTimeFormats[3] := nfLongTime; SollDateTimeFormatStrings[3] := ''; SollDateTimeFormats[4] := nfShortTimeAM; SollDateTimeFormatStrings[4] := ''; SollDateTimeFormats[5] := nfLongTimeAM; SollDateTimeFormatStrings[5] := ''; - SollDateTimeFormats[6] := nfFmtDateTime; SollDateTimeFormatStrings[6] := 'dm'; - SolLDateTimeFormats[7] := nfFmtDateTime; SollDateTimeFormatStrings[7] := 'my'; - SollDateTimeFormats[8] := nfFmtDateTime; SollDateTimeFormatStrings[8] := 'ms'; + SollDateTimeFormats[6] := nfCustom; SollDateTimeFormatStrings[6] := 'dd/mmm'; + SolLDateTimeFormats[7] := nfCustom; SollDateTimeFormatStrings[7] := 'mmm/yy'; + SollDateTimeFormats[8] := nfCustom; SollDateTimeFormatStrings[8] := 'nn:ss'; SollDateTimeFormats[9] := nfTimeInterval; SollDateTimeFormatStrings[9] := ''; for i:=Low(SollDateTimes) to High(SollDateTimes) do begin - SollDateTimeStrings[i, 0] := DateToStr(SollDateTimes[i]) + ' ' + FormatDateTime('t', SollDateTimes[i]); - SollDateTimeStrings[i, 1] := DateToStr(SollDateTimes[i]); - SollDateTimeStrings[i, 2] := FormatDateTime(fs.ShortTimeFormat, SollDateTimes[i]); - SolLDateTimeStrings[i, 3] := FormatDateTime(fs.LongTimeFormat, SollDateTimes[i]); - SollDateTimeStrings[i, 4] := FormatDateTime(fs.ShortTimeFormat + ' am/pm', SollDateTimes[i]); // dont't use "t" - it does the hours wrong - SollDateTimeStrings[i, 5] := FormatDateTime(fs.LongTimeFormat + ' am/pm', SollDateTimes[i]); - SollDateTimeStrings[i, 6] := FormatDateTime(SpecialDateTimeFormat('dm', fs, false), SollDateTimes[i]); - SollDateTimeStrings[i, 7] := FormatDateTime(SpecialDateTimeFormat('my', fs, false), SollDateTimes[i]); - SollDateTimeStrings[i, 8] := FormatDateTime(SpecialDateTimeFormat('ms', fs, false), SollDateTimes[i]); - SollDateTimeStrings[i, 9] := FormatDateTime('[h]:mm:ss', SollDateTimes[i], [fdoInterval]); + SollDateTimeStrings[i, 0] := DateToStr(SollDateTimes[i], fs) + ' ' + FormatDateTime('t', SollDateTimes[i], fs); + SollDateTimeStrings[i, 1] := DateToStr(SollDateTimes[i], fs); + SollDateTimeStrings[i, 2] := FormatDateTime(fs.ShortTimeFormat, SollDateTimes[i], fs); + SolLDateTimeStrings[i, 3] := FormatDateTime(fs.LongTimeFormat, SollDateTimes[i], fs); + SollDateTimeStrings[i, 4] := FormatDateTime(fs.ShortTimeFormat + ' am/pm', SollDateTimes[i], fs); // dont't use "t" - it does the hours wrong + SollDateTimeStrings[i, 5] := FormatDateTime(fs.LongTimeFormat + ' am/pm', SollDateTimes[i], fs); + SollDateTimeStrings[i, 6] := FormatDateTime(SpecialDateTimeFormat('dm', fs, false), SollDateTimes[i], fs); + SollDateTimeStrings[i, 7] := FormatDateTime(SpecialDateTimeFormat('my', fs, false), SollDateTimes[i], fs); + SollDateTimeStrings[i, 8] := FormatDateTime(SpecialDateTimeFormat('ms', fs, false), SollDateTimes[i], fs); + SollDateTimeStrings[i, 9] := FormatDateTime('[h]:mm:ss', SollDateTimes[i], fs, [fdoInterval]); end; // Column width @@ -345,7 +350,7 @@ begin MyWorksheet := MyWorkbook.AddWorksheet(FmtDateTimesSheet); for Row := Low(SollDateTimes) to High(SollDateTimes) do for Col := Low(SollDateTimeFormats) to High(SollDateTimeFormats) do begin - if (AFormat = sfExcel2) and (SollDateTimeFormats[Col] in [nfFmtDateTime, nfTimeInterval]) then + if (AFormat = sfExcel2) and (SollDateTimeFormats[Col] in [nfCustom, nfTimeInterval]) then Continue; // The formats nfFmtDateTime and nfTimeInterval are not supported by BIFF2 MyWorksheet.WriteDateTime(Row, Col, SollDateTimes[Row], SollDateTimeFormats[Col], SollDateTimeFormatStrings[Col]); ActualString := MyWorksheet.ReadAsUTF8Text(Row, Col); @@ -369,7 +374,7 @@ begin fail('Error in test code. Failed to get named worksheet'); for Row := Low(SollDateTimes) to High(SollDateTimes) do for Col := Low(SollDateTimeFormats) to High(SollDateTimeFormats) do begin - if (AFormat = sfExcel2) and (SollDateTimeFormats[Col] in [nfFmtDateTime, nfTimeInterval]) then + if (AFormat = sfExcel2) and (SollDateTimeFormats[Col] in [nfCustom, nfTimeInterval]) then Continue; // The formats nfFmtDateTime and nfTimeInterval are not supported by BIFF2 ActualString := MyWorksheet.ReadAsUTF8Text(Row,Col); CheckEquals( diff --git a/components/fpspreadsheet/tests/numformatparsertests.pas b/components/fpspreadsheet/tests/numformatparsertests.pas index 1455cf9c0..c8fb68cc3 100644 --- a/components/fpspreadsheet/tests/numformatparsertests.pas +++ b/components/fpspreadsheet/tests/numformatparsertests.pas @@ -46,6 +46,7 @@ implementation uses TypInfo; +{ The test will use Excel strings and convert them to fpc dialect } procedure InitParserTestData; begin // Tests with 1 format section only @@ -146,14 +147,16 @@ var i: Integer; parser: TsNumFormatParser; MyWorkbook: TsWorkbook; + actual: String; begin MyWorkbook := TsWorkbook.Create; // needed to provide the FormatSettings for the parser try for i:=0 to 5 do begin - parser := TsNumFormatParser.Create(MyWorkbook, ParserTestData[i].FormatString, cdToFPSpreadsheet); + parser := TsNumFormatParser.Create(MyWorkbook, ParserTestData[i].FormatString); try - CheckEquals(ParserTestData[i].SollFormatString, parser.FormatString, - 'Test format string ' + ParserTestData[i].FormatString + ' construction mismatch'); + actual := parser.FormatString[nfdDefault]; + CheckEquals(ParserTestData[i].SollFormatString, actual, + 'Test format string ' + ParserTestData[i].SollFormatString + ' construction mismatch'); CheckEquals(ord(ParserTestData[i].SollNumFormat), ord(parser.ParsedSections[0].NumFormat), 'Test format (' + GetEnumName(TypeInfo(TsNumberFormat), integer(ParserTestData[i].SollNumFormat)) + ') detection mismatch'); diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi index 750a96485..f6cc33bad 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpi +++ b/components/fpspreadsheet/tests/spreadtestgui.lpi @@ -48,9 +48,6 @@ - - - @@ -173,9 +170,6 @@ - - - diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas index b7a806eef..215f6ac2d 100755 --- a/components/fpspreadsheet/xlsbiff2.pas +++ b/components/fpspreadsheet/xlsbiff2.pas @@ -61,8 +61,7 @@ type procedure ApplyCellFormatting(ARow, ACol: Cardinal; XFIndex: Word); override; procedure CreateNumFormatList; override; procedure ExtractNumberFormat(AXFIndex: WORD; - out ANumberFormat: TsNumberFormat; out ADecimals: Byte; - out ACurrencySymbol: String; out ANumberFormatStr: String); override; + out ANumberFormat: TsNumberFormat; out ANumberFormatStr: String); override; procedure ReadBlank(AStream: TStream); override; procedure ReadColWidth(AStream: TStream); procedure ReadFont(AStream: TStream); @@ -139,7 +138,7 @@ var implementation uses - Math; + Math, fpsNumFormatParser; const { Excel record IDs } @@ -181,21 +180,23 @@ begin ts := fs.ThousandSeparator; cs := fs.CurrencyString; AddFormat( 0, '', nfGeneral); - AddFormat( 1, '0', nfFixed, 0); - AddFormat( 2, '0'+ds+'00', nfFixed, 2); // 0.00 - AddFormat( 3, '#'+ts+'##0', nfFixedTh, 0); // #,##0 - AddFormat( 4, '#'+ts+'##0'+ds+'00', nfFixedTh, 2); // #,##0.00 - AddFormat( 5, UTF8ToAnsi('"'+cs+'"#'+ts+'##0_);("'+cs+'"#'+ts+'##0)'), nfCurrency, 0); - AddFormat( 6, UTF8ToAnsi('"'+cs+'"#'+ts+'##0_);[Red]("'+cs+'"#'+ts+'##0)'), nfCurrencyRed, 2); - AddFormat( 7, UTF8ToAnsi('"'+cs+'"#'+ts+'##0'+ds+'00_);("'+cs+'"#'+ts+'##0'+ds+'00)'), nfCurrency, 0); - AddFormat( 8, UTF8ToAnsi('"'+cs+'"#'+ts+'##0'+ds+'00_);[Red]("'+cs+'"#'+ts+'##0'+ds+'00)'), nfCurrency, 2); - AddFormat( 9, '0%', nfPercentage, 0); - AddFormat(10, '0'+ds+'00%', nfPercentage, 2); - AddFormat(11, '0'+ds+'00E+00', nfExp, 2); + AddFormat( 1, '0', nfFixed); + AddFormat( 2, '0'+ds+'00', nfFixed); // 0.00 + AddFormat( 3, '#'+ts+'##0', nfFixedTh); // #,##0 + AddFormat( 4, '#'+ts+'##0'+ds+'00', nfFixedTh); // #,##0.00 + AddFormat( 5, UTF8ToAnsi('"'+cs+'"#'+ts+'##0_);("'+cs+'"#'+ts+'##0)'), nfCurrency); + AddFormat( 6, UTF8ToAnsi('"'+cs+'"#'+ts+'##0_);[Red]("'+cs+'"#'+ts+'##0)'), nfCurrencyRed); + AddFormat( 7, UTF8ToAnsi('"'+cs+'"#'+ts+'##0'+ds+'00_);("'+cs+'"#'+ts+'##0'+ds+'00)'), nfCurrency); + AddFormat( 8, UTF8ToAnsi('"'+cs+'"#'+ts+'##0'+ds+'00_);[Red]("'+cs+'"#'+ts+'##0'+ds+'00)'), nfCurrency); + AddFormat( 9, '0%', nfPercentage); + AddFormat(10, '0'+ds+'00%', nfPercentage); + AddFormat(11, '0'+ds+'00E+00', nfExp); AddFormat(12, fs.ShortDateFormat, nfShortDate); AddFormat(13, fs.LongDateFormat, nfLongDate); - AddFormat(14, SpecialDateTimeFormat('dm', fs, true), nfFmtDateTime); - AddFormat(15, SpecialDateTimeFormat('my', fs, true), nfFmtDateTime); + AddFormat(14, 'd/mmm', nfCustom); + AddFormat(15, 'mmm/yy', nfCustom); + //AddFormat(14, SpecialDateTimeFormat('dm', fs, true), nfFmtDateTime); + //AddFormat(15, SpecialDateTimeFormat('my', fs, true), nfFmtDateTime); AddFormat(16, AddAMPM(fs.ShortTimeFormat, fs), nfShortTimeAM); AddFormat(17, AddAMPM(fs.LongTimeFormat, fs), nfLongTimeAM); AddFormat(18, fs.ShortTimeFormat, nfShortTime); @@ -223,6 +224,7 @@ begin if ADecimals > 0 then ADecimals := 2; ANumFormat := nfExp; end; + { nfFmtDateTime: begin fmt := lowercase(AFormatString); @@ -248,6 +250,7 @@ begin else ANumFormat := nfShortDateTime; end; + } nfCustom, nfTimeInterval: begin ANumFormat := nfGeneral; @@ -261,18 +264,28 @@ end; function TsBIFF2NumFormatList.FindFormatOf(AFormatCell: PCell): Integer; var fmt: String; + parser: TsNumFormatParser; + decs: Integer; + dt: string; begin + parser := TsNumFormatParser.Create(Workbook, AFormatCell^.NumberFormatStr); + try + decs := parser.Decimals; + dt := parser.GetDateTimeCode(0); + finally + parser.Free; + end; + case AFormatCell^.NumberFormat of nfGeneral, - nfCustom, nfTimeInterval : Result := 0; - nfFixed : Result := IfThen(AFormatCell^.Decimals = 0, 1, 2); - nfFixedTh : Result := IfThen(AFormatCell^.Decimals = 0, 3, 4); + nfFixed : Result := IfThen(decs = 0, 1, 2); + nfFixedTh : Result := IfThen(decs = 0, 3, 4); nfCurrency, - nfAccounting : Result := IfThen(AFormatCell^.Decimals = 0, 5, 7); + nfAccounting : Result := IfThen(decs = 0, 5, 7); nfCurrencyRed, - nfAccountingRed : Result := IfThen(AFormatCell^.Decimals = 0, 6, 8); - nfPercentage : Result := IfThen(AFormatCell^.Decimals = 0, 9, 10); + nfAccountingRed : Result := IfThen(decs = 0, 6, 8); + nfPercentage : Result := IfThen(decs = 0, 9, 10); nfExp, nfSci : Result := 11; nfShortDate : Result := 12; nfLongDate : Result := 13; @@ -281,38 +294,8 @@ begin nfShortTime : Result := 18; nfLongTime : Result := 19; nfShortDateTime : Result := 20; - nfFmtDateTime : begin - fmt := lowercase(AFormatCell^.NumberFormatStr); - if (fmt = 'd-mmm') or (fmt = 'd/mmm') or - (fmt = 'd-mm') or (fmt = 'd/mm') or - (fmt = 'dd-mm') or (fmt = 'dd/mm') or - (fmt = 'dd-mmm') or (fmt = 'dd/mmm') - then - Result := 14 - else - if (fmt = 'mmm-yy') or (fmt = 'mmm/yy') or - (fmt = 'mm-yy') or (fmt = 'mm/yy') or - (fmt = 'm-yy') or (fmt = 'm/y') or - (fmt = 'mmm-yyyy') or (fmt = 'mmm/yyyy') or - (fmt = 'mm-yyyy') or (fmt = 'mm/yyyy') or - (fmt = 'm-yyyy') or (fmt = 'm/yyyy') - then - Result := 15 - else - if (fmt = 'nn:ss') or (fmt = 'mm:ss') or - (fmt = 'n:ss') or (fmt = 'm:ss') - then - Result := 19 - else - if (fmt = 'nn:ss.z') or (fmt = 'mm:ss.z') or - (fmt = 'n:ss.z') or (fmt = 'm:ss.z') or - (fmt = 'nn:ss.zzz') or (fmt = 'mm:ss.zzz') or - (fmt = 'n:ss.zzz') or (fmt = 'm:ss.zzz') - then - Result := 19 - else - Result := 20; - end; + nfCustom : if dt = 'dm' then Result := 14 else + if dt = 'my' then Result := 15; end; end; @@ -383,8 +366,7 @@ end; { Extracts the number format data from an XF record indexed by AXFIndex. Note that BIFF2 supports only 21 formats. } procedure TsSpreadBIFF2Reader.ExtractNumberFormat(AXFIndex: WORD; - out ANumberFormat: TsNumberFormat; out ADecimals: Byte; - out ACurrencySymbol: String; out ANumberFormatStr: String); + out ANumberFormat: TsNumberFormat; out ANumberFormatStr: String); var lNumFormatData: TsNumFormatData; begin @@ -392,13 +374,9 @@ begin if lNumFormatData <> nil then begin ANumberFormat := lNumFormatData.NumFormat; ANumberFormatStr := lNumFormatData.FormatString; - ADecimals := lNumFormatData.Decimals; - ACurrencySymbol := lNumFormatData.CurrencySymbol; end else begin ANumberFormat := nfGeneral; ANumberFormatStr := ''; - ADecimals := 0; - ACurrencySymbol := ''; end; end; @@ -575,11 +553,11 @@ begin Move(Data[0], formulaResult, SizeOf(Data)); {Find out what cell type, set content type and value} - ExtractNumberFormat(XF, nf, nd, ncs, nfs); - if IsDateTime(formulaResult, nf, dt) then + ExtractNumberFormat(XF, nf, nfs); + if IsDateTime(formulaResult, nf, nfs, dt) then FWorksheet.WriteDateTime(ARow, ACol, dt, nf, nfs) else - FWorksheet.WriteNumber(ARow, ACol, formulaResult, nf, nd, ncs); + FWorksheet.WriteNumber(ARow, ACol, formulaResult, nf, nfs); end; { Formula token array } @@ -645,11 +623,11 @@ begin AStream.ReadBuffer(value, 8); {Find out what cell type, set content type and value} - ExtractNumberFormat(XF, nf, nd, ncs, nfs); - if IsDateTime(value, nf, dt) then + ExtractNumberFormat(XF, nf, nfs); + if IsDateTime(value, nf, nfs, dt) then FWorksheet.WriteDateTime(ARow, ACol, dt, nf, nfs) else - FWorksheet.WriteNumber(ARow, ACol, value, nf, nd, ncs); + FWorksheet.WriteNumber(ARow, ACol, value, nf, nfs); { Apply formatting to cell } ApplyCellFormatting(ARow, ACol, XF); @@ -902,6 +880,7 @@ begin // but the number format list of the writer is in Excel syntax. // And for BIFF2, there is only a limited number of formats. lCell := ACell^; + { with lCell do begin if IsDateTimeFormat(NumberFormat) then NumberFormatStr := BuildDateTimeFormatString(NumberFormat, @@ -911,6 +890,7 @@ begin Workbook.FormatSettings, Decimals, CurrencySymbol); NumFormatList.ConvertBeforeWriting(NumberFormatStr, NumberFormat, Decimals, CurrencyString); end; + } lIndex := FindFormattingInList(@lCell); // Carefully check the index @@ -925,14 +905,13 @@ var i: Integer; begin inherited ListAllFormattingStyles; - + { for i:=0 to High(FFormattingStyles) do FNumFormatList.ConvertBeforeWriting( FFormattingStyles[i].NumberFormatStr, - FFormattingStyles[i].NumberFormat, - FFormattingStyles[i].Decimals, - FFormattingStyles[i].CurrencySymbol + FFormattingStyles[i].NumberFormat ); + } end; { Builds up the list of number formats to be written to the biff2 file. diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index c4e033d7b..e6bdd3672 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -310,6 +310,8 @@ begin // Now apply the modifications. if uffNumberFormat in FFormattingStyles[i].UsedFormattingFields then begin + // The number formats in the FormattingStyles are still in fpc dialect + // They will be converted to Excel syntax immediately before writing. j := NumFormatList.FindFormatOf(@FFormattingStyles[i]); if j > -1 then lFormatIndex := NumFormatList[j].Index; diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index f96a37751..c36f35374 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -357,6 +357,9 @@ type TsBIFFNumFormatList = class(TsCustomNumFormatList) protected procedure AddBuiltinFormats; override; + procedure ConvertBeforeWriting(var AFormatString: String; + var ANumFormat: TsNumberFormat; var ADecimals: Byte; + var ACurrencySymbol: String); override; public end; @@ -375,13 +378,15 @@ type function DecodeRKValue(const ARK: DWORD): Double; // Returns the numberformat for a given XF record procedure ExtractNumberFormat(AXFIndex: WORD; - out ANumberFormat: TsNumberFormat; out ADecimals: Byte; - out ACurrencySymbol: String; out ANumberFormatStr: String); virtual; + out ANumberFormat: TsNumberFormat; //out ADecimals: Byte; + //out ACurrencySymbol: String; + out ANumberFormatStr: String); virtual; // Finds format record for XF record pointed to by cell // Will not return info for built-in formats function FindNumFormatDataForCell(const AXFIndex: Integer): TsNumFormatData; // Tries to find if a number cell is actually a date/datetime/time cell and retrieves the value - function IsDateTime(Number: Double; ANumberFormat: TsNumberFormat; var ADateTime: TDateTime): Boolean; + function IsDateTime(Number: Double; ANumberFormat: TsNumberFormat; + ANumberFormatStr: String; var ADateTime: TDateTime): Boolean; // Here we can add reading of records which didn't change across BIFF5-8 versions procedure ReadCodePage(AStream: TStream); // Read column info @@ -708,48 +713,50 @@ end; { These are the built-in number formats as expected in the biff spreadsheet file. In BIFF5+ they are not written to file but they are used for lookup of the - number format that Excel used. They have to be converted to fpspreadsheet format. } + number format that Excel used. They are specified here in fpc dialect. } procedure TsBIFFNumFormatList.AddBuiltinFormats; var + fs: TFormatSettings; cs: String; begin + fs := Workbook.FormatSettings; cs := AnsiToUTF8(Workbook.FormatSettings.CurrencyString); AddFormat( 0, '', nfGeneral); - AddFormat( 1, '0', nfFixed, 0); - AddFormat( 2, '0.00', nfFixed, 2); - AddFormat( 3, '#,##0', nfFixedTh, 0); - AddFormat( 4, '#,##0.00', nfFixedTh, 2); - AddFormat( 5, '"'+cs+'"#,##0_);("'+cs+'"#,##0)', nfCurrency, 0); - AddFormat( 6, '"'+cs+'"#,##0_);[Red]("'+cs+'"#,##0)', nfCurrencyRed, 0); - AddFormat( 7, '"'+cs+'"#,##0.00_);("'+cs+'"#,##0.00)', nfCurrency, 2); - AddFormat( 8, '"'+cs+'"#,##0.00_);[Red]("'+cs+'"#,##0.00)', nfCurrencyRed, 2); - AddFormat( 9, '0%', nfPercentage, 0); - AddFormat(10, '0.00%', nfPercentage, 2); - AddFormat(11, '0.00E+00', nfExp, 2); + AddFormat( 1, '0', nfFixed); + AddFormat( 2, '0.00', nfFixed); + AddFormat( 3, '#,##0', nfFixedTh); + AddFormat( 4, '#,##0.00', nfFixedTh); + AddFormat( 5, '"'+cs+'"#,##0_);("'+cs+'"#,##0)', nfCurrency); + AddFormat( 6, '"'+cs+'"#,##0_);[Red]("'+cs+'"#,##0)', nfCurrencyRed); + AddFormat( 7, '"'+cs+'"#,##0.00_);("'+cs+'"#,##0.00)', nfCurrency); + AddFormat( 8, '"'+cs+'"#,##0.00_);[Red]("'+cs+'"#,##0.00)', nfCurrencyRed); + AddFormat( 9, '0%', nfPercentage); + AddFormat(10, '0.00%', nfPercentage); + AddFormat(11, '0.00E+00', nfExp); // fraction formats 12 ('# ?/?') and 13 ('# ??/??') not supported - AddFormat(14, 'M/D/YY', nfShortDate); - AddFormat(15, 'D-MMM-YY', nfLongDate); - AddFormat(16, 'D-MMM', nfFmtDateTime); - AddFormat(17, 'MMM-YY', nfFmtDateTime); - AddFormat(18, 'h:mm AM/PM', nfShortTimeAM); - AddFormat(19, 'h:mm:ss AM/PM', nfLongTimeAM); - AddFormat(20, 'h:mm', nfShortTime); - AddFormat(21, 'h:mm:ss', nfLongTime); - AddFormat(22, 'M/D/YY h:mm', nfShortDateTime); + AddFormat(14, fs.ShortDateFormat, nfShortDate); // 'M/D/YY' + AddFormat(15, fs.LongDateFormat, nfLongDate); // 'D-MMM-YY' + AddFormat(16, 'd/mmm', nfCustom); // 'D-MMM' + AddFormat(17, 'mmm/yy', nfCustom); // 'MMM-YY' + AddFormat(18, AddAMPM(fs.ShortTimeFormat, fs), nfShortTimeAM); // 'h:mm AM/PM' + AddFormat(19, AddAMPM(fs.LongTimeFormat, fs), nfLongTimeAM); // 'h:mm:ss AM/PM' + AddFormat(20, fs.ShortTimeFormat, nfShortTime); // 'h:mm' + AddFormat(21, fs.LongTimeFormat, nfLongTime); // 'h:mm:ss' + AddFormat(22, fs.ShortDateFormat + ' ' + fs.ShortTimeFormat, nfShortDateTime); // 'M/D/YY h:mm' (localized) // 23..36 not supported - AddFormat(37, '_(#,##0_);(#,##0)', nfCurrency, 0); - AddFormat(38, '_(#,##0_);[Red](#,##0)', nfCurrencyRed, 0); - AddFormat(39, '_(#,##0.00_);(#,##0.00)', nfCurrency, 2); - AddFormat(40, '_(#,##0.00_);[Red](#,##0.00)', nfCurrencyRed, 2); - AddFormat(41, '_("'+cs+'"* #,##0_);_("'+cs+'"* (#,##0);_("'+cs+'"* "-"_);_(@_)', nfAccounting, 0); - AddFormat(42, '_(* #,##0_);_(* (#,##0);_(* "-"_);_(@_)', nfAccounting, 0); - AddFormat(43, '_("'+cs+'"* #,##0.00_);_("'+cs+'"* (#,##0.00);_("'+cs+'"* "-"??_);_(@_)', nfAccounting, 2); - AddFormat(44, '_(* #,##0.00_);_(* (#,##0.00);_(* "-"??_);_(@_)', nfAccounting, 2); - AddFormat(45, 'mm:ss', nfFmtDateTime); - AddFormat(46, '[h]:mm:ss', nfTimeInterval); - AddFormat(47, 'mm:ss.0', nfFmtDateTime); - AddFormat(48, '##0.0E+00', nfSci, 1); + AddFormat(37, '_(#,##0_);(#,##0)', nfCurrency); + AddFormat(38, '_(#,##0_);[Red](#,##0)', nfCurrencyRed); + AddFormat(39, '_(#,##0.00_);(#,##0.00)', nfCurrency); + AddFormat(40, '_(#,##0.00_);[Red](#,##0.00)', nfCurrencyRed); + AddFormat(41, '_("'+cs+'"* #,##0_);_("'+cs+'"* (#,##0);_("'+cs+'"* "-"_);_(@_)', nfAccounting); + AddFormat(42, '_(* #,##0_);_(* (#,##0);_(* "-"_);_(@_)', nfAccounting); + AddFormat(43, '_("'+cs+'"* #,##0.00_);_("'+cs+'"* (#,##0.00);_("'+cs+'"* "-"??_);_(@_)', nfAccounting); + AddFormat(44, '_(* #,##0.00_);_(* (#,##0.00);_(* "-"??_);_(@_)', nfAccounting); + AddFormat(45, 'nn:ss', nfCustom); + AddFormat(46, '[h]:nn:ss', nfTimeInterval); + AddFormat(47, 'nn:ss.z', nfCustom); + AddFormat(48, '##0.0E+00', nfSci); // 49 ("Text") not supported // All indexes from 0 to 163 are reserved for built-in formats. @@ -758,6 +765,26 @@ begin FNextFormatIndex := 164; end; +procedure TsBIFFNumFormatList.ConvertBeforeWriting(var AFormatString: String; + var ANumFormat: TsNumberFormat; var ADecimals: Byte; var ACurrencySymbol: String); +var + parser: TsNumFormatParser; + fmt: String; +begin + parser := TsNumFormatParser.Create(Workbook, AFormatString); + try + if parser.Status = psOK then begin + // We convert the fpc format string to Excel dialect + AFormatString := parser.FormatString[nfdExcel]; + ANumFormat := parser.NumFormat; + ADecimals := parser.Decimals; + ACurrencySymbol := parser.CurrencySymbol; + end; + finally + parser.Free; + end; +end; + { TsSpreadBIFFReader } @@ -840,12 +867,14 @@ var begin FreeAndNil(FNumFormatList); FNumFormatList := TsBIFFNumFormatList.Create(Workbook); + (* // Convert builtin formats to fps syntax for i:=0 to FNumFormatList.Count-1 do begin item := FNumFormatList[i]; FNumFormatList.ConvertAfterReading(item.Index, item.FormatString, item.NumFormat, item.Decimals, item.CurrencySymbol); end; + *) end; { Extracts a number out of an RK value. @@ -883,8 +912,9 @@ end; { Extracts number format data from an XF record index by AXFIndex. Valid for BIFF5-BIFF8. Needs to be overridden for BIFF2 } procedure TsSpreadBIFFReader.ExtractNumberFormat(AXFIndex: WORD; - out ANumberFormat: TsNumberFormat; out ADecimals: Byte; - out ACurrencySymbol: String; out ANumberFormatStr: String); + out ANumberFormat: TsNumberFormat; //out ADecimals: Byte; + //out ACurrencySymbol: String; + out ANumberFormatStr: String); var lNumFormatData: TsNumFormatData; begin @@ -892,13 +922,13 @@ begin if lNumFormatData <> nil then begin ANumberFormat := lNumFormatData.NumFormat; ANumberFormatStr := lNumFormatData.FormatString; - ADecimals := lNumFormatData.Decimals; - ACurrencySymbol := lNumFormatData.CurrencySymbol; +// ADecimals := lNumFormatData.Decimals; +// ACurrencySymbol := lNumFormatData.CurrencySymbol; end else begin ANumberFormat := nfGeneral; ANumberFormatStr := ''; - ADecimals := 0; - ACurrencySymbol := ''; +// ADecimals := 0; +// ACurrencySymbol := ''; end; end; @@ -918,22 +948,30 @@ end; { Convert the number to a date/time and return that if it is } function TsSpreadBIFFReader.IsDateTime(Number: Double; - ANumberFormat: TsNumberFormat; var ADateTime: TDateTime): boolean; + ANumberFormat: TsNumberFormat; ANumberFormatStr: String; + var ADateTime: TDateTime): boolean; +var + parser: TsNumFormatParser; begin + Result := true; if ANumberFormat in [ - nfShortDateTime, nfFmtDateTime, nfShortDate, nfLongDate, - nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM] then - begin - ADateTime := ConvertExcelDateTimeToDateTime(Number, FDateMode); - Result := true; - end else - if ANumberFormat = nfTimeInterval then begin - ADateTime := Number; - Result := true; - end else - begin - ADateTime := 0; - Result := false; + nfShortDateTime, {nfFmtDateTime, }nfShortDate, nfLongDate, + nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM] + then + ADateTime := ConvertExcelDateTimeToDateTime(Number, FDateMode) + else + if ANumberFormat = nfTimeInterval then + ADateTime := Number + else begin + parser := TsNumFormatParser.Create(Workbook, ANumberFormatStr); + try + if (parser.Status = psOK) and parser.IsDateTimeFormat then + ADateTime := ConvertExcelDateTimeToDateTime(Number, FDateMode) + else + Result := false; + finally + parser.Free; + end; end; end; @@ -1108,11 +1146,11 @@ begin Move(Data[0], ResultFormula, SizeOf(Data)); {Find out what cell type, set content type and value} - ExtractNumberFormat(XF, nf, nd, ncs, nfs); - if IsDateTime(ResultFormula, nf, dt) then + ExtractNumberFormat(XF, nf, nfs); + if IsDateTime(ResultFormula, nf, nfs, dt) then FWorksheet.WriteDateTime(ARow, ACol, dt, nf, nfs) else - FWorksheet.WriteNumber(ARow, ACol, ResultFormula, nf, nd, ncs); + FWorksheet.WriteNumber(ARow, ACol, ResultFormula, nf, nfs); //, nd, ncs); end; { Formula token array } @@ -1174,11 +1212,11 @@ begin RK := DWordLEtoN(AStream.ReadDWord); lNumber := DecodeRKValue(RK); {Find out what cell type, set contenttype and value} - ExtractNumberFormat(XF, nf, nd, ncs, nfs); - if IsDateTime(lNumber, nf, lDateTime) then + ExtractNumberFormat(XF, nf, nfs); + if IsDateTime(lNumber, nf, nfs, lDateTime) then FWorksheet.WriteDateTime(ARow, fc, lDateTime, nf, nfs) else - FWorksheet.WriteNumber(ARow, fc, lNumber, nf, nd, ncs); + FWorksheet.WriteNumber(ARow, fc, lNumber, nf, nfs); inc(fc); dec(pending, SizeOf(XF) + SizeOf(RK)); end; @@ -1210,13 +1248,11 @@ begin AStream.ReadBuffer(value, 8); {Find out what cell type, set content type and value} - ExtractNumberFormat(XF, nf, nd, ncs, nfs); - if IsDateTime(value, nf, dt) then - FWorksheet.WriteDateTime(ARow, ACol, dt) //, nf, nfs) + ExtractNumberFormat(XF, nf, nfs); + if IsDateTime(value, nf, nfs, dt) then + FWorksheet.WriteDateTime(ARow, ACol, dt, nf, nfs) else - //if nf <> nfCustom then // why was this here? - FWorksheet.WriteNumber(ARow, ACol, value, nf, nd, ncs); - FWorksheet.WriteNumberFormat(ARow, ACol, nf, nfs); // override built-in format string + FWorksheet.WriteNumber(ARow, ACol, value, nf, nfs); { Add attributes to cell } ApplyCellFormatting(ARow, ACol, XF); @@ -1297,17 +1333,17 @@ begin Number := DecodeRKValue(RK); {Find out what cell type, set contenttype and value} - ExtractNumberFormat(XF, nf, nd, ncs, nfs); - if IsDateTime(Number, nf, lDateTime) then + ExtractNumberFormat(XF, nf, nfs); + if IsDateTime(Number, nf, nfs, lDateTime) then FWorksheet.WriteDateTime(ARow, ACol, lDateTime, nf, nfs) else - FWorksheet.WriteNumber(ARow, ACol, Number, nf, nd, ncs); + FWorksheet.WriteNumber(ARow, ACol, Number, nf, nfs); {Add attributes} ApplyCellFormatting(ARow, ACol, XF); end; -// Read the part of the ROW record that is common to all BIFF versions +// Read the part of the ROW record that is common to BIFF3-8 versions procedure TsSpreadBIFFReader.ReadRowInfo(AStream: TStream); type TRowRecord = packed record @@ -1325,6 +1361,21 @@ var h: word; begin AStream.ReadBuffer(rowrec, SizeOf(TRowRecord)); + + // if bit 6 is set in the flags row height does not match the font size. + // Only for this case we create a row record for fpspreadsheet + if rowrec.Flags and $00000040 <> 0 then begin + lRow := FWorksheet.GetRow(WordLEToN(rowrec.RowIndex)); + // row height is encoded into the 15 lower bits in units "twips" (1/20 pt) + // we need it in "lines", i.e. we divide the points by the point size of the default font + h := WordLEToN(rowrec.Height) and $7FFF; + lRow^.Height := TwipsToPts(h) / FWorkbook.GetDefaultFontSize; + if lRow^.Height > ROW_HEIGHT_CORRECTION then + lRow^.Height := lRow^.Height - ROW_HEIGHT_CORRECTION + else + lRow^.Height := 0; + end; +{ h := WordLEToN(rowrec.Height); if h and $8000 = 0 then begin // if this bit were set, rowheight would be default lRow := FWorksheet.GetRow(WordLEToN(rowrec.RowIndex)); @@ -1336,6 +1387,7 @@ begin else lRow^.Height := 0; end; + } end; { Reads the cell address used in an RPN formula element. Evaluates the corresponding @@ -2118,6 +2170,7 @@ begin // But we have to consider that the number formats of the cell is in fpc syntax, // but the number format list of the writer is in Excel syntax. lCell := ACell^; + (* with lCell do begin if NumberFormat <> nfCustom then begin if IsDateTimeFormat(NumberFormat) then @@ -2126,9 +2179,10 @@ begin else NumberFormatStr := BuildNumberFormatString(NumberFormat, Workbook.FormatSettings, Decimals, CurrencySymbol); - NumFormatList.ConvertBeforeWriting(NumberFormatStr, NumberFormat, Decimals, CurrencyString); + //NumFormatList.ConvertBeforeWriting(NumberFormatStr, NumberFormat, Decimals, CurrencyString); end; end; + *) lIndex := FindFormattingInList(@lCell); // Carefully check the index