diff --git a/components/fpspreadsheet/examples/other/demo_expression_parser.pas b/components/fpspreadsheet/examples/other/demo_expression_parser.pas index 4c4feb6e1..abe1e06da 100644 --- a/components/fpspreadsheet/examples/other/demo_expression_parser.pas +++ b/components/fpspreadsheet/examples/other/demo_expression_parser.pas @@ -110,5 +110,8 @@ begin workbook.Free; end; + WriteLn('Press ENTER to quit...'); + ReadLn; + end. diff --git a/components/fpspreadsheet/examples/read_write/csvdemo/csvwrite.lpr b/components/fpspreadsheet/examples/read_write/csvdemo/csvwrite.lpr index 67eef94ce..15eb56968 100644 --- a/components/fpspreadsheet/examples/read_write/csvdemo/csvwrite.lpr +++ b/components/fpspreadsheet/examples/read_write/csvdemo/csvwrite.lpr @@ -14,7 +14,6 @@ uses var MyWorkbook: TsWorkbook; MyWorksheet: TsWorksheet; - MyRPNFormula: TsRPNFormula; MyDir: string; number: Double; lCol: TCol; diff --git a/components/fpspreadsheet/examples/read_write/excel2demo/excel2write.lpr b/components/fpspreadsheet/examples/read_write/excel2demo/excel2write.lpr index cd639eca9..fa234474e 100644 --- a/components/fpspreadsheet/examples/read_write/excel2demo/excel2write.lpr +++ b/components/fpspreadsheet/examples/read_write/excel2demo/excel2write.lpr @@ -12,6 +12,9 @@ program excel2write; uses Classes, SysUtils, fpsTypes, fpspreadsheet, xlsbiff2; +const + NA_COLOR = scCyan; // Color if number format is not available in biff2 + var MyWorkbook: TsWorkbook; MyWorksheet: TsWorksheet; @@ -89,10 +92,10 @@ begin // Write cell with background color MyWorksheet.WriteUTF8Text(3, 0, 'Text'); - MyWorksheet.WriteBackgroundColor(3, 0, scSilver); + MyWorksheet.WriteBackgroundColor(3, 0, NA_COLOR); // Empty cell with background color - MyWorksheet.WriteBackgroundColor(3, 1, scGrey); + MyWorksheet.WriteBackgroundColor(3, 1, NA_COLOR); // Cell2 with top and bottom borders MyWorksheet.WriteUTF8Text(4, 0, 'Text'); @@ -121,7 +124,7 @@ begin r:= 10; // Write current date/time and test numbers for various formatting options - MyWorksheet.WriteUTF8Text(r, 1, 'Formats in gray cells are not supported by BIFF2'); + MyWorksheet.WriteUTF8Text(r, 1, 'Formats in cyan cells are not supported by BIFF2'); inc(r, 2); MyWorksheet.WriteUTF8Text(r, 0, 'nfShortDate'); @@ -139,11 +142,11 @@ begin MyWorksheet.WriteUTF8Text(r, 0, 'nfShortDateTime'); MyWorksheet.WriteDateTime(r, 1, now, nfShortDateTime); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, ''dd/mmm'''); - MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'dd/mmm'''); + MyWorksheet.WriteUTF8Text(r, 0, 'nfDayMonth'); + MyWorksheet.WriteDateTime(r, 1, now, nfDayMonth); inc(r); - MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, ''mmm/yy'''); - MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'mmm/yy'); + MyWorksheet.WriteUTF8Text(r, 0, 'nfMonthYear'); + MyWorksheet.WriteDateTime(r, 1, now, nfMonthYear); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfShortTimeAM'); MyWorksheet.WriteDateTime(r, 1, now, nfShortTimeAM); @@ -153,15 +156,15 @@ begin inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, nn:ss'); MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'nn:ss'); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, nn:ss.z'); MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'nn:ss.z'); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, mm:ss.zzz'); MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'mm:ss.zzz'); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); // Write formatted numbers number := 12345.67890123456789; @@ -179,9 +182,9 @@ begin inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfFixed, 1 decs'); MyWorksheet.WriteNumber(r, 1, number, nfFixed, 1); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); MyWorksheet.WriteNumber(r, 2, -number, nfFixed, 1); - MyWorksheet.WriteFontColor(r, 2, scGray); + MyWorksheet.WriteFontColor(r, 2, NA_COLOR); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfFixed, 2 decs'); MyWorksheet.WriteNumber(r, 1, number, nfFixed, 2); @@ -189,9 +192,9 @@ begin inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfFixed, 3 decs'); MyWorksheet.WriteNumber(r, 1, number, nfFixed, 3); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); MyWorksheet.WriteNumber(r, 2, -number, nfFixed, 3); - MyWorksheet.WriteFontColor(r, 2, scGray); + MyWorksheet.WriteFontColor(r, 2, NA_COLOR); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 0 decs'); MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 0); @@ -199,9 +202,9 @@ begin inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 1 decs'); MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 1); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); MyWorksheet.WriteNumber(r, 2, -number, nfFixedTh, 1); - MyWorksheet.WriteFontColor(r, 2, scGray); + MyWorksheet.WriteFontColor(r, 2, NA_COLOR); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 2 decs'); MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 2); @@ -209,19 +212,19 @@ begin inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 3 decs'); MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 3); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); MyWorksheet.WriteNumber(r, 2, -number, nfFixedTh, 3); - MyWorksheet.WriteFontColor(r, 2, scGray); + MyWorksheet.WriteFontColor(r, 2, NA_COLOR); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfExp, 1 dec'); MyWorksheet.WriteNumber(r, 1, number, nfExp, 1); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); MyWorksheet.WriteNumber(r, 2, -number, nfExp, 1); - MyWorksheet.WriteFontColor(r, 2, scGray); + MyWorksheet.WriteFontColor(r, 2, NA_COLOR); MyWorksheet.WriteNumber(r, 3, 1.0/number, nfExp, 1); - MyWorksheet.WriteFontColor(r, 3, scGray); + MyWorksheet.WriteFontColor(r, 3, NA_COLOR); MyWorksheet.WriteNumber(r, 4, -1.0/number, nfExp, 1); - MyWorksheet.WriteFontColor(r, 4, scGray); + MyWorksheet.WriteFontColor(r, 4, NA_COLOR); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfExp, 2 decs'); MyWorksheet.WriteNumber(r, 1, number, nfExp, 2); @@ -231,13 +234,13 @@ begin inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfExp, 3 decs'); MyWorksheet.WriteNumber(r, 1, number, nfExp, 3); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); MyWorksheet.WriteNumber(r, 2, -number, nfExp, 3); - MyWorksheet.WriteFontColor(r, 2, scGray); + MyWorksheet.WriteFontColor(r, 2, NA_COLOR); MyWorksheet.WriteNumber(r, 3, 1.0/number, nfExp, 3); - MyWorksheet.WriteFontColor(r, 3, scGray); + MyWorksheet.WriteFontColor(r, 3, NA_COLOR); MyWorksheet.WriteNumber(r, 4, -1.0/number, nfExp, 3); - MyWorksheet.WriteFontColor(r, 4, scGray); + MyWorksheet.WriteFontColor(r, 4, NA_COLOR); inc(r,2); MyWorksheet.WriteUTF8Text(r, 0, 'nfCurrency, 0 decs'); MyWorksheet.WriteCurrency(r, 1, number, nfCurrency, 0, '$'); @@ -251,45 +254,45 @@ begin inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, "$"#,##0_);("$"#,##0)'); MyWorksheet.WriteNumber(r, 1, number); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); MyWorksheet.WriteNumberFormat(r, 1, nfCustom, '"$"#,##0_);("$"#,##0)'); MyWorksheet.WriteNumber(r, 2, -number); MyWorksheet.WriteNumberFormat(r, 2, nfCustom, '"$"#,##0_);("$"#,##0)'); - MyWorksheet.WriteFontColor(r, 2, scGray); + MyWorksheet.WriteFontColor(r, 2, NA_COLOR); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, "$"#,##0.0_);[Red]("$"#,##0.0)'); MyWorksheet.WriteNumber(r, 1, number); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); 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)'); - MyWorksheet.WriteFontColor(r, 2, scGray); + MyWorksheet.WriteFontColor(r, 2, NA_COLOR); inc(r); fmt := '"€"#,##0.0_);[Red]("€"#,##0.0)'; MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, '+fmt); MyWorksheet.WriteNumber(r, 1, number); MyWorksheet.WriteNumberFormat(r, 1, nfCustom, UTF8ToAnsi(fmt)); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); MyWorksheet.WriteNumber(r, 2, -number); MyWorksheet.WriteNumberFormat(r, 2, nfCustom, UTF8ToAnsi(fmt)); - MyWorksheet.WriteFontColor(r, 2, scGray); + MyWorksheet.WriteFontColor(r, 2, NA_COLOR); inc(r); fmt := '[Green]"¥"#,##0.0_);[Red]-"¥"#,##0.0'; MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, '+fmt); MyWorksheet.WriteNumber(r, 1, number); MyWorksheet.WriteNumberFormat(r, 1, nfCustom, UTF8ToAnsi(fmt)); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); MyWorksheet.WriteNumber(r, 2, -number); MyWorksheet.WriteNumberFormat(r, 2, nfCustom, UTF8ToAnsi(fmt)); - MyWorksheet.WriteFontColor(r, 2, scGray); + MyWorksheet.WriteFontColor(r, 2, NA_COLOR); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, _("$"* #,##0_);_("$"* (#,##0);_("$"* "-"_);_(@_)'); MyWorksheet.WriteNumber(r, 1, number); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); MyWorksheet.WriteNumberFormat(r, 1, nfCustom, '_("$"* #,##0_);_("$"* (#,##0);_("$"* "-"_);_(@_)'); MyWorksheet.WriteNumber(r, 2, -number); MyWorksheet.WriteNumberFormat(r, 2, nfCustom, '_("$"* #,##0_);_("$"* (#,##0);_("$"* "-"_);_(@_)'); - MyWorksheet.WriteFontColor(r, 2, scGray); + MyWorksheet.WriteFontColor(r, 2, NA_COLOR); inc(r, 2); number := 1.333333333; MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 0 decs'); @@ -297,34 +300,34 @@ begin inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 1 decs'); MyWorksheet.WriteNumber(r, 1, number, nfPercentage, 1); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 2 decs'); MyWorksheet.WriteNumber(r, 1, number, nfPercentage, 2); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 3 decs'); MyWorksheet.WriteNumber(r, 1, number, nfPercentage, 3); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, hh:mm:ss'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, h:m:s'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'H:M:s'); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, hh:mm'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'hh:mm'); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, h:m'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'h:m'); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, h'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'h'); - MyWorksheet.WriteFontColor(r, 1, scGray); + MyWorksheet.WriteFontColor(r, 1, NA_COLOR); inc(r); // Set width of columns 0 to 3 diff --git a/components/fpspreadsheet/examples/read_write/excel5demo/excel5write.lpr b/components/fpspreadsheet/examples/read_write/excel5demo/excel5write.lpr index 8fbbc05de..92805ca70 100644 --- a/components/fpspreadsheet/examples/read_write/excel5demo/excel5write.lpr +++ b/components/fpspreadsheet/examples/read_write/excel5demo/excel5write.lpr @@ -336,6 +336,15 @@ begin inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, h'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'h'); + inc(r); + MyWorksheet.WriteUTF8Text(r, 0, 'nfFraction, ??/??'); + MyWorksheet.WriteNumber(r, 1, number); + MyWorksheet.WriteFractionFormat(r, 1, false, 2, 2); + + inc(r); + MyWorksheet.WriteUTF8Text(r, 0, 'nfFraction, # ??/??'); + MyWorksheet.WriteNumber(r, 1, number); + MyWorksheet.WriteFractionFormat(r, 1, true, 2, 2); //MyFormula.FormulaStr := ''; diff --git a/components/fpspreadsheet/examples/read_write/excel8demo/excel8write.lpr b/components/fpspreadsheet/examples/read_write/excel8demo/excel8write.lpr index 4097857e4..96da10b56 100644 --- a/components/fpspreadsheet/examples/read_write/excel8demo/excel8write.lpr +++ b/components/fpspreadsheet/examples/read_write/excel8demo/excel8write.lpr @@ -361,6 +361,12 @@ begin inc(r); MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [ss]'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[ss]'); + inc(r); + MyWorksheet.WriteUTF8Text(r, 0, 'nfFraction, ??/??'); + Myworksheet.WriteNumber(r, 1, number, nfFraction, '??/??'); + inc(r); + MyWorksheet.WriteUTF8Text(r, 0, 'nfFraction, # ??/??'); + Myworksheet.WriteNumber(r, 1, number, nfFraction, '# ??/??'); // Set width of columns 0, 1 and 5 MyWorksheet.WriteColWidth(0, 30); diff --git a/components/fpspreadsheet/examples/read_write/ooxmldemo/ooxmlwrite.lpr b/components/fpspreadsheet/examples/read_write/ooxmldemo/ooxmlwrite.lpr index 2404c6a8d..ee2914c39 100644 --- a/components/fpspreadsheet/examples/read_write/ooxmldemo/ooxmlwrite.lpr +++ b/components/fpspreadsheet/examples/read_write/ooxmldemo/ooxmlwrite.lpr @@ -105,6 +105,7 @@ begin Myworksheet.Writenumber(5, 6, 12345.6789, nfExp, 4); MyWorksheet.WriteCurrency(6, 6,-12345.6789, nfCurrency, 2); MyWorksheet.WriteCurrency(7, 6,-12345.6789, nfCurrencyRed, 2); + MyWorksheet.WriteNumber(8, 6, 1.66666667, nfFraction, '# ?/?'); // Save the spreadsheet to a file MyWorkbook.WriteToFile(MyDir + 'test.xlsx', sfOOXML); diff --git a/components/fpspreadsheet/examples/read_write/opendocdemo/opendocwrite.lpr b/components/fpspreadsheet/examples/read_write/opendocdemo/opendocwrite.lpr index 1b9a2fab0..9102c082f 100644 --- a/components/fpspreadsheet/examples/read_write/opendocdemo/opendocwrite.lpr +++ b/components/fpspreadsheet/examples/read_write/opendocdemo/opendocwrite.lpr @@ -203,6 +203,16 @@ begin MyWorksheet.WriteCurrency(row, 6, number6, nfCurrencyRed, 2, '$', pcfCSV, ncfBCSVB); MyWorksheet.WriteCurrency(row, 7, number7, nfCurrencyRed, 2, '$', pcfCSV, ncfBCSVB); MyWorksheet.WriteCurrency(row, 8, number8, nfCurrencyRed, 2, '$', pcfCSV, ncfBCSVB); + inc(row); + MyWorksheet.WriteUTF8Text(row, 0, 'nfFraction, 2 digits'); + MyWorksheet.WriteNumber(row, 1, number1, nfFraction, '# ???/???'); + MyWorksheet.WriteNumber(row, 2, number2, nfFraction, '# ???/???'); + MyWorksheet.WriteNumber(row, 3, number3, nfFraction, '# ???/???'); + MyWorksheet.WriteNumber(row, 4, number4, nfFraction, '# ???/???'); + MyWorksheet.WriteNumber(row, 5, number5, nfFraction, '# ???/???'); + MyWorksheet.WriteNumber(row, 6, number6, nfFraction, '# ???/???'); + MyWorksheet.WriteNumber(row, 7, number7, nfFraction, '# ???/???'); + MyWorksheet.WriteNumber(row, 8, number8, nfFraction, '# ???/???'); inc(row,2); MyWorksheet.WriteUTF8Text(row, 0, 'Some date/time values in various formats:'); diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/demo_ctrls.lpi b/components/fpspreadsheet/examples/visual/fpsctrls/demo_ctrls.lpi index 7b58e9315..6a13ccd1b 100644 --- a/components/fpspreadsheet/examples/visual/fpsctrls/demo_ctrls.lpi +++ b/components/fpspreadsheet/examples/visual/fpsctrls/demo_ctrls.lpi @@ -109,7 +109,6 @@ - diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm b/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm index e527c6d0f..b99afd30a 100644 --- a/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm +++ b/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm @@ -837,6 +837,7 @@ object MainForm: TMainForm Dialog.Filter = 'Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited files (*.csv)|*.csv|WikiTable (WikiMedia-Format, *.wikitable_wikimedia)|*.wikitable_wikimedia' Hint = 'Save spreadsheet' ImageIndex = 45 + BeforeExecute = AcFileSaveAsBeforeExecute OnAccept = AcFileSaveAsAccept end object AcViewInspector: TAction diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/main.pas b/components/fpspreadsheet/examples/visual/fpsctrls/main.pas index be62fffbb..db41a7946 100644 --- a/components/fpspreadsheet/examples/visual/fpsctrls/main.pas +++ b/components/fpspreadsheet/examples/visual/fpsctrls/main.pas @@ -312,6 +312,7 @@ type procedure AcColDeleteExecute(Sender: TObject); procedure AcFileOpenAccept(Sender: TObject); procedure AcFileSaveAsAccept(Sender: TObject); + procedure AcFileSaveAsBeforeExecute(Sender: TObject); procedure AcRowAddExecute(Sender: TObject); procedure AcRowDeleteExecute(Sender: TObject); procedure AcSettingsCSVParamsExecute(Sender: TObject); @@ -405,6 +406,14 @@ begin end; end; +procedure TMainForm.AcFileSaveAsBeforeExecute(Sender: TObject); +begin + if WorkbookSource.FileName = '' then + exit; + AcfileSaveAs.Dialog.InitialDir := ExtractFileDir(WorkbookSource.FileName); + AcFileSaveAs.Dialog.FileName := ExtractFileName(WorkbookSource.FileName); +end; + { Adds a row before the active cell } procedure TMainForm.AcRowAddExecute(Sender: TObject); begin diff --git a/components/fpspreadsheet/examples/visual/spready/spready.lpi b/components/fpspreadsheet/examples/visual/spready/spready.lpi index e46eaf3d7..10e09fd9f 100644 --- a/components/fpspreadsheet/examples/visual/spready/spready.lpi +++ b/components/fpspreadsheet/examples/visual/spready/spready.lpi @@ -27,6 +27,13 @@ + + + + + + + diff --git a/components/fpspreadsheet/fpsactions.pas b/components/fpspreadsheet/fpsactions.pas index 3f49ba3ea..223019cd4 100644 --- a/components/fpspreadsheet/fpsactions.pas +++ b/components/fpspreadsheet/fpsactions.pas @@ -1003,7 +1003,8 @@ var nfs: String; begin Worksheet.ReadNumFormat(ACell, nf, nfs); - Checked := (ACell <> nil) and (nf = FNumberFormat) and (nfs = FNumberFormatStr); + Checked := (ACell <> nil) and (nf = FNumberFormat) and + ((FNumberFormatStr = '') or (nfs = FNumberFormatStr)); end; @@ -1341,8 +1342,6 @@ var txt: String; cellStr: String; hyperlink: TsHyperlink; - displayText: String; - cell: PCell; begin Unused(Target); diff --git a/components/fpspreadsheet/fpsclasses.pas b/components/fpspreadsheet/fpsclasses.pas index f55d908fc..a2ff857c5 100644 --- a/components/fpspreadsheet/fpsclasses.pas +++ b/components/fpspreadsheet/fpsclasses.pas @@ -290,7 +290,7 @@ begin if FCurrentNode <> nil then begin curr := PsRowCol(FCurrentNode.Data); - if (curr^.Col < FStartCol) then + if (LongInt(curr^.Col) < FStartCol) then while (FCurrentNode <> nil) and not InRange(curr^.Col, FStartCol, FEndCol) do begin FCurrentNode := FTree.FindSuccessor(FCurrentNode); diff --git a/components/fpspreadsheet/fpscurrency.pas b/components/fpspreadsheet/fpscurrency.pas index 19b5833a1..33623fe86 100644 --- a/components/fpspreadsheet/fpscurrency.pas +++ b/components/fpspreadsheet/fpscurrency.pas @@ -38,7 +38,7 @@ var -------------------------------------------------------------------------------} procedure RegisterCurrency(ACurrencySymbol: String); begin - if not CurrencyRegistered(ACurrencySymbol) then + if not CurrencyRegistered(ACurrencySymbol) and (ACurrencySymbol <> '') then CurrencyList.Add(ACurrencySymbol); end; diff --git a/components/fpspreadsheet/fpsnumformat.pas b/components/fpspreadsheet/fpsnumformat.pas index 87aac1b26..bfd8a5884 100644 --- a/components/fpspreadsheet/fpsnumformat.pas +++ b/components/fpspreadsheet/fpsnumformat.pas @@ -11,132 +11,52 @@ uses fpstypes, fpspreadsheet; type - {@@ Contents of a number format record } - TsNumFormatData = class - public - {@@ Excel refers to a number format by means of the format "index". } - Index: Integer; - {@@ OpenDocument refers to a number format by means of the format "name". } - Name: String; - {@@ Identifier of a built-in number format, see TsNumberFormat } - NumFormat: TsNumberFormat; - {@@ String of format codes, such as '#,##0.00', or 'hh:nn'. } - FormatString: string; - end; + { TsNumFormatList } - {@@ Specialized list for number format items } - TsCustomNumFormatList = class(TFPList) + TsNumFormatList = class(TFPList) private - function GetItem(AIndex: Integer): TsNumFormatData; - procedure SetItem(AIndex: Integer; AValue: TsNumFormatData); + FOwnsData: Boolean; + function GetItem(AIndex: Integer): TsNumFormatParams; + procedure SetItem(AIndex: Integer; const AValue: TsNumFormatParams); protected - {@@ Workbook from which the number formats are collected in the list. It is - mainly needed to get access to the FormatSettings for easy localization of some - formatting strings. } FWorkbook: TsWorkbook; - {@@ Identifies the first number format item that is written to the file. Items - having a smaller index are not written. } - FFirstNumFormatIndexInFile: Integer; - {@@ Identifies the index of the next Excel number format item to be written. - Needed for auto-creating of the user-defined Excel number format indexes } - FNextNumFormatIndex: Integer; + FClass: TsNumFormatParamsClass; procedure AddBuiltinFormats; virtual; - procedure RemoveFormat(AIndex: Integer); - public - constructor Create(AWorkbook: TsWorkbook); + constructor Create(AWorkbook: TsWorkbook; AOwnsData: Boolean); destructor Destroy; override; - function AddFormat(AFormatIndex: Integer; AFormatName: String; - ANumFormat: TsNumberFormat; AFormatString: String): Integer; overload; - function AddFormat(AFormatIndex: Integer; ANumFormat: TsNumberFormat; - AFormatString: String): Integer; overload; - function AddFormat(AFormatName: String; ANumFormat: TsNumberFormat; - AFormatString: String): Integer; overload; - function AddFormat(ANumFormat: TsNumberFormat; AFormatString: String): Integer; overload; - procedure AnalyzeAndAdd(AFormatIndex: Integer; AFormatString: String); + function AddFormat(ASections: TsNumFormatSections): Integer; overload; + function AddFormat(AFormatStr: String; ADialect: TsNumFormatDialect): Integer; overload; procedure Clear; - procedure ConvertAfterReading(AFormatIndex: Integer; var AFormatString: String; - var ANumFormat: TsNumberFormat); virtual; - procedure ConvertBeforeWriting(var AFormatString: String; - var ANumFormat: TsNumberFormat); virtual; procedure Delete(AIndex: Integer); - function Find(ANumFormat: TsNumberFormat; AFormatString: String): Integer; virtual; - function FindByFormatStr(AFormatString: String): Integer; - function FindByIndex(AFormatIndex: Integer): Integer; - function FindByName(AFormatName: String): Integer; - function FormatStringForWriting(AIndex: Integer): String; virtual; - procedure Sort; - + function Find(ASections: TsNumFormatSections): Integer; + property Items[AIndex: Integer]: TsNumFormatParams read GetItem write SetItem; default; {@@ Workbook from which the number formats are collected in the list. It is - mainly needed to get access to the FormatSettings for easy localization of some - formatting strings. } + mainly needed to get access to the FormatSettings for easy localization of + some formatting strings. } property Workbook: TsWorkbook read FWorkbook; - {@@ Identifies the first number format item that is written to the file. Items - having a smaller index are not written. } - property FirstNumFormatIndexInFile: Integer read FFirstNumFormatIndexInFile; - {@@ Number format items contained in the list } - property Items[AIndex: Integer]: TsNumFormatData read GetItem write SetItem; default; end; -function FormatAsFraction(ANumFormatStr: String; AValue: Double): String; -function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean; +function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean; overload; +function IsCurrencyFormat(ANumFormat: TsNumFormatParams): Boolean; overload; + function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; overload; function IsDateTimeFormat(AFormatStr: String): Boolean; overload; +function IsDateTimeFormat(ANumFormat: TsNumFormatParams): Boolean; overload; + function IsTimeFormat(AFormat: TsNumberFormat): Boolean; overload; function IsTimeFormat(AFormatStr: String): Boolean; overload; +function IsTimeFormat(ANumFormat: TsNumFormatParams): Boolean; overload; + +function IsTimeIntervalFormat(ANumFormat: TsNumFormatParams): Boolean; implementation uses - Math, fpsUtils, fpsNumFormatParser; -{@@ ---------------------------------------------------------------------------- - Formats a floating point value as a fraction according to the specified - formatting string. - - @param ANumFormatStr String with formatting codes --------------------------------------------------------------------------------} -function FormatAsFraction(ANumFormatStr: String; AValue: Double): String; -var - parser: TsNumFormatParser; - int,num,denom: Integer; - maxNum, maxDenom: Integer; - isNeg: Boolean; -begin - if AValue < 0 then begin - isNeg := true; - AValue := abs(AValue); - end else - isNeg := false; - - parser := TsNumFormatParser.Create(nil, ANumFormatStr); - try - if parser.NumFormat <> nfFraction then - raise Exception.Create('[FormatAsFraction] No formatting string for fractions.'); - - if parser.FracInt = 0 then - int := 0 - else - begin - int := trunc(AValue); - AValue := frac(AValue); - end; - maxNum := Round(IntPower(10, parser.FracNumerator)); - maxDenom := Round(IntPower(10, parser.FracDenominator)); - FloatToFraction(AValue, maxNum, maxDenom, num, denom); - if int = 0 then - Result := Format('%d/%d', [num, denom]) - else - Result := Format('%d %d/%d', [int, num, denom]); - if isNeg then Result := '-' + Result; - finally - parser.Free; - end; -end; - {@@ ---------------------------------------------------------------------------- Checks whether the given number format code is for currency, i.e. requires currency symbol. @@ -149,6 +69,19 @@ begin Result := AFormat in [nfCurrency, nfCurrencyRed]; end; +{@@ ---------------------------------------------------------------------------- + Checks whether the specified number format parameters apply to currency values. + + @param ANumFormat Number format parameters + @return True if Kind of the 1st format parameter section contains the + nfkCurrency elements; false otherwise +-------------------------------------------------------------------------------} +function IsCurrencyFormat(ANumFormat: TsNumFormatParams): Boolean; +begin + Result := (ANumFormat <> nil) and + (ANumFormat.Sections[0].Kind * [nfkCurrency] <> []); +end; + {@@ ---------------------------------------------------------------------------- Checks whether the given number format code is for date/time values. @@ -158,8 +91,9 @@ end; -------------------------------------------------------------------------------} function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; begin - Result := AFormat in [{nfFmtDateTime, }nfShortDateTime, nfShortDate, nfLongDate, - nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, nfTimeInterval]; + Result := AFormat in [nfShortDateTime, nfShortDate, nfLongDate, + nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, + nfDayMonth, nfMonthYear, nfTimeInterval]; end; {@@ ---------------------------------------------------------------------------- @@ -181,6 +115,19 @@ begin end; end; +{@@ ---------------------------------------------------------------------------- + Checks whether the specified number format parameters apply to date/time values. + + @param ANumFormat Number format parameters + @return True if Kind of the 1st format parameter section contains the + nfkDate or nfkTime elements; false otherwise +-------------------------------------------------------------------------------} +function IsDateTimeFormat(ANumFormat: TsNumFormatParams): Boolean; +begin + Result := (ANumFormat <> nil) and + (ANumFormat.Sections[0].Kind * [nfkDate, nfkTime] <> []); +end; + {@@ ---------------------------------------------------------------------------- Checks whether the given built-in number format code is for time values. @@ -211,398 +158,128 @@ begin end; end; +{@@ ---------------------------------------------------------------------------- + Checks whether the specified number format parameters apply to time values. -{******************************************************************************* -* TsCustomNumFormatList * -*******************************************************************************} + @param ANumFormat Number format parameters + @return True if Kind of the 1st format parameter section contains the + nfkTime elements; false otherwise +-------------------------------------------------------------------------------} +function IsTimeFormat(ANumFormat: TsNumFormatParams): Boolean; +begin + Result := (ANumFormat <> nil) and + (ANumFormat.Sections[0].Kind * [nfkTime] <> []); +end; {@@ ---------------------------------------------------------------------------- - Constructor of the number format list. + Checks whether the specified number format parameters is a time interval + format. - @param AWorkbook The workbook is needed to get access to its "FormatSettings" - for localization of some formatting strings. + @param ANumFormat Number format parameters + @return True if Kind of the 1st format parameter section contains the + nfkTimeInterval elements; false otherwise -------------------------------------------------------------------------------} -constructor TsCustomNumFormatList.Create(AWorkbook: TsWorkbook); +function IsTimeIntervalFormat(ANumFormat: TsNumFormatParams): Boolean; +begin + Result := (ANumFormat <> nil) and + (ANumFormat.Sections[0].Kind * [nfkTimeInterval] <> []); +end; + + +{ TsNumFormatList } + +constructor TsNumFormatList.Create(AWorkbook: TsWorkbook; AOwnsData: Boolean); begin inherited Create; + FClass := TsNumFormatParams; FWorkbook := AWorkbook; - AddBuiltinFormats; + FOwnsData := AOwnsData; end; -{@@ ---------------------------------------------------------------------------- - Destructor of the number format list: clears the list and destroys the - format items --------------------------------------------------------------------------------} -destructor TsCustomNumFormatList.Destroy; +destructor TsNumFormatList.Destroy; begin Clear; - inherited Destroy; + inherited; end; -{@@ ---------------------------------------------------------------------------- - Adds a number format described by the Excel format index, the ODF format - name, the format string, and the built-in format identifier to the list - and returns the index of the new item. - - @param AFormatIndex Format index to be used by Excel - @param AFormatName Format name to be used by OpenDocument - @param AFormatString String of formatting codes - @param ANumFormat Identifier for built-in number format - @return List index of the new item --------------------------------------------------------------------------------} -function TsCustomNumFormatList.AddFormat(AFormatIndex: Integer; - AFormatName: String; ANumFormat: TsNumberFormat; AFormatString: String): Integer; +function TsNumFormatList.AddFormat(ASections: TsNumFormatSections): Integer; var - item: TsNumFormatData; + item: TsNumFormatParams; begin - item := TsNumFormatData.Create; - item.Index := AFormatIndex; - item.Name := AFormatName; - item.NumFormat := ANumFormat; - item.FormatString := AFormatString; - Result := inherited Add(item); -end; - -{@@ ---------------------------------------------------------------------------- - Adds a number format described by the Excel format index, the format string, - and the built-in format identifier to the list and returns the index of - the new item in the format list. To be used when writing an Excel file. - - @param AFormatIndex Format index to be used by Excel - @param ANumFormat Identifier for built-in number format - @param AFormatString String of formatting codes - @return Index of the new item in the format list --------------------------------------------------------------------------------} -function TsCustomNumFormatList.AddFormat(AFormatIndex: Integer; - ANumFormat: TsNumberFormat; AFormatString: String): integer; -begin - Result := AddFormat(AFormatIndex, '', ANumFormat, AFormatString); -end; - -{@@ ---------------------------------------------------------------------------- - Adds a number format described by the ODF format name, the format string, - and the built-in format identifier to the list and returns the index of - the new item in the format list. To be used when writing an ODS file. - - @param AFormatName Format name to be used by OpenDocument - @param AFormatString String of formatting codes - @param ANumFormat Identifier for built-in number format - @return Index of the new item in the format list --------------------------------------------------------------------------------} -function TsCustomNumFormatList.AddFormat(AFormatName: String; - ANumFormat: TsNumberFormat; AFormatString: String): Integer; -begin - if (AFormatString = '') and (ANumFormat <> nfGeneral) then - begin - Result := 0; - exit; + Result := Find(ASections); + if Result = -1 then begin + item := FClass.Create; + item.Sections := ASections; + Result := inherited Add(item); end; - Result := AddFormat(FNextNumFormatIndex, AFormatName, ANumFormat, AFormatString); - inc(FNextNumFormatIndex); end; -{@@ ---------------------------------------------------------------------------- - Adds a number format described by the format string, and the built-in - format identifier to the format list and returns the index of the new - item in the list. The Excel format index and ODS format name are auto-generated. - - @param ANumFormat Identifier for built-in number format - @param AFormatString String of formatting codes - @return Index of the new item in the list --------------------------------------------------------------------------------} -function TsCustomNumFormatList.AddFormat(ANumFormat: TsNumberFormat; - AFormatString: String): Integer; -begin - Result := AddFormat('', ANumFormat, AFormatString); -end; - -{@@ ---------------------------------------------------------------------------- - Adds the builtin format items to the list. The formats must be specified in - a way that is compatible with fpc syntax. - - Conversion of the formatstrings to the syntax used in the destination file - can be done by calling "ConvertAfterReadung" bzw. "ConvertBeforeWriting". - "AddBuiltInFormats" must be called before user items are added. - - Must specify FFirstNumFormatIndexInFile (BIFF5-8, e.g. don't save formats <164) - and must initialize the index of the first user format (FNextNumFormatIndex) - which is automatically incremented when adding user formats. - - In TsCustomNumFormatList nothing is added. --------------------------------------------------------------------------------} -procedure TsCustomNumFormatList.AddBuiltinFormats; -begin - // must be overridden - see xlscommon as an example. -end; - -{@@ ---------------------------------------------------------------------------- - Called from the reader when a format item has been read from an Excel file. - Determines the number format type, format string etc and converts the - format string to fpc syntax which is used directly for getting the cell text. - - @param AFormatIndex Excel index of the number format read from the file - @param AFormatString String of formatting codes as read fromt the file. --------------------------------------------------------------------------------} -procedure TsCustomNumFormatList.AnalyzeAndAdd(AFormatIndex: Integer; - AFormatString: String); -var - nf: TsNumberFormat = nfGeneral; -begin - if FindByIndex(AFormatIndex) > -1 then - exit; - - // Analyze & convert the format string, extract infos for internal formatting - ConvertAfterReading(AFormatIndex, AFormatString, nf); - - // Add the new item - AddFormat(AFormatIndex, nf, AFormatString); -end; - -{@@ ---------------------------------------------------------------------------- - Clears the number format list and frees memory occupied by the format items. --------------------------------------------------------------------------------} -procedure TsCustomNumFormatList.Clear; -var - i: Integer; -begin - for i:=0 to Count-1 do RemoveFormat(i); - inherited Clear; -end; - -{@@ ---------------------------------------------------------------------------- - Takes the format string as it is read from the file and extracts the - built-in number format identifier out of it for use by fpc. - The method also converts the format string to a form that can be used - by fpc's FormatDateTime and FormatFloat. - - The method should be overridden in a class that knows knows more about the - details of the spreadsheet file format. - - @param AFormatIndex Excel index of the number format read - @param AFormatString string of formatting codes extracted from the file data - @param ANumFormat identifier for built-in fpspreadsheet format extracted - from the file data --------------------------------------------------------------------------------} -procedure TsCustomNumFormatList.ConvertAfterReading(AFormatIndex: Integer; - var AFormatString: String; var ANumFormat: TsNumberFormat); +function TsNumFormatList.AddFormat(AFormatStr: String; + ADialect: TsNumFormatDialect): Integer; var parser: TsNumFormatParser; - fmt: String; - lFormatData: TsNumFormatData; + newSections: TsNumFormatSections; i: Integer; begin - i := FindByIndex(AFormatIndex); - if i > 0 then - begin - lFormatData := Items[i]; - fmt := lFormatData.FormatString; - end else - fmt := AFormatString; - - // Analyzes the format string and tries to convert it to fpSpreadsheet format. - parser := TsNumFormatParser.Create(Workbook, fmt); + parser := TsNumFormatParser.Create(FWorkbook, AFormatStr, ADialect); try - if parser.Status = psOK then + SetLength(newSections, parser.ParsedSectionCount); + for i:=0 to High(newSections) do begin - ANumFormat := parser.NumFormat; - AFormatString := parser.FormatString[nfdDefault]; - end else - begin - // Show an error here? + newSections[i] := parser.ParsedSections[i]; end; + Result := AddFormat(newSections); finally parser.Free; end; end; -{@@ ---------------------------------------------------------------------------- - Is called before collecting all number formats of the spreadsheet and before - writing them to file. Its purpose is to convert the format string as used by fpc - to a format compatible with the spreadsheet file format. - Nothing is changed in the TsCustomNumFormatList, the method needs to be - overridden by a descendant class which known more about the details of the - destination file format. - - Needs to be overridden by a class knowing more about the destination file - format. - - @param AFormatString String of formatting codes. On input in fpc syntax. Is - overwritten on output by format string compatible with - the destination file. - @param ANumFormat Identifier for built-in fpspreadsheet number format --------------------------------------------------------------------------------} -procedure TsCustomNumFormatList.ConvertBeforeWriting(var AFormatString: String; - var ANumFormat: TsNumberFormat); +procedure TsNumFormatList.AddBuiltinFormats; begin - Unused(AFormatString, ANumFormat); - // nothing to do here. But see, e.g., xlscommon.TsBIFFNumFormatList end; - -{@@ ---------------------------------------------------------------------------- - Deletes a format item from the list, and makes sure that its memory is - released. - - @param AIndex List index of the item to be deleted. --------------------------------------------------------------------------------} -procedure TsCustomNumFormatList.Delete(AIndex: Integer); -begin - RemoveFormat(AIndex); - Delete(AIndex); -end; - -{@@ ---------------------------------------------------------------------------- - Seeks a format item with the given properties and returns its list index, - or -1 if not found. - - @param ANumFormat Built-in format identifier - @param AFormatString String of formatting codes - @return Index of the format item in the format list, - or -1 if not found. --------------------------------------------------------------------------------} -function TsCustomNumFormatList.Find(ANumFormat: TsNumberFormat; - AFormatString: String): Integer; +procedure TsNumFormatList.Clear; var - item: TsNumFormatData; + i: Integer; begin - for Result := Count-1 downto 0 do + for i := Count-1 downto 0 do Delete(i); + inherited; +end; + +procedure TsNumFormatList.Delete(AIndex: Integer); +var + p: TsNumFormatParams; +begin + if FOwnsData then begin - item := Items[Result]; - if (item <> nil) and (item.NumFormat = ANumFormat) and (item.FormatString = AFormatString) - then exit; + p := GetItem(AIndex); + if p <> nil then p.Free; end; - Result := -1; + inherited Delete(AIndex); end; -{@@ ---------------------------------------------------------------------------- - Finds the item with the given format string and returns its index in the - format list, or -1 if not found. - - @param AFormatString string of formatting codes to be searched in the list. - @return Index of the format item in the format list, or -1 if not found. --------------------------------------------------------------------------------} -function TsCustomNumFormatList.FindByFormatStr(AFormatString: String): integer; +function TsNumFormatList.Find(ASections: TsNumFormatSections): Integer; var - item: TsNumFormatData; + item: TsNumFormatParams; begin - { We search backwards to find user-defined items first. They usually are - more appropriate than built-in items. } - for Result := Count-1 downto 0 do - begin - item := Items[Result]; - if item.FormatString = AFormatString then + for Result := 0 to Count-1 do begin + item := GetItem(Result); + if item.SectionsEqualTo(ASections) then exit; end; Result := -1; end; -{@@ ---------------------------------------------------------------------------- - Finds the item with the given Excel format index and returns its index in - the format list, or -1 if not found. - Is used by BIFF file formats. - - @param AFormatIndex Excel format index to the searched - @return Index of the format item in the format list, or -1 if not found. --------------------------------------------------------------------------------} -function TsCustomNumFormatList.FindByIndex(AFormatIndex: Integer): integer; -var - item: TsNumFormatData; +function TsNumFormatList.GetItem(AIndex: Integer): TsNumFormatParams; begin - for Result := 0 to Count-1 do - begin - item := Items[Result]; - if item.Index = AFormatIndex then - exit; - end; - Result := -1; + Result := TsNumFormatParams(inherited Items[AIndex]); end; -{@@ ---------------------------------------------------------------------------- - Finds the item with the given ODS format name and returns its index in - the format list (or -1, if not found) - To be used by OpenDocument file format. - - @param AFormatName Format name as used by OpenDocument to identify a - number format - - @return Index of the format item in the list, or -1 if not found --------------------------------------------------------------------------------} -function TsCustomNumFormatList.FindByName(AFormatName: String): integer; -var - item: TsNumFormatData; -begin - for Result := 0 to Count-1 do - begin - item := Items[Result]; - if item.Name = AFormatName then - exit; - end; - Result := -1; -end; - -{@@ ---------------------------------------------------------------------------- - Determines the format string to be written into the spreadsheet file. Calls - ConvertBeforeWriting in order to convert the fpc format strings to the dialect - used in the file. - - @param AIndex Index of the format item under consideration. - @return String of formatting codes that will be written to the file. --------------------------------------------------------------------------------} -function TsCustomNumFormatList.FormatStringForWriting(AIndex: Integer): String; -var - item: TsNumFormatdata; - nf: TsNumberFormat; -begin - item := Items[AIndex]; - if item <> nil then - begin - Result := item.FormatString; - nf := item.NumFormat; - ConvertBeforeWriting(Result, nf); - end else - Result := ''; -end; - -function TsCustomNumFormatList.GetItem(AIndex: Integer): TsNumFormatData; -begin - Result := TsNumFormatData(inherited Items[AIndex]); -end; - -{@@ ---------------------------------------------------------------------------- - Deletes the memory occupied by the formatting data, but keeps an empty item in - the list to retain the indexes of following items. - - @param AIndex The number format item at this index will be removed. --------------------------------------------------------------------------------} -procedure TsCustomNumFormatList.RemoveFormat(AIndex: Integer); -var - item: TsNumFormatData; -begin - item := GetItem(AIndex); - if item <> nil then - begin - item.Free; - SetItem(AIndex, nil); - end; -end; - -procedure TsCustomNumFormatList.SetItem(AIndex: Integer; AValue: TsNumFormatData); +procedure TsNumFormatList.SetItem(AIndex: Integer; + const AValue: TsNumFormatParams); begin inherited Items[AIndex] := AValue; end; -function CompareNumFormatData(Item1, Item2: Pointer): Integer; -begin - Result := CompareValue(TsNumFormatData(Item1).Index, TsNumFormatData(Item2).Index); -end; - -{@@ ---------------------------------------------------------------------------- - Sorts the format data items in ascending order of the Excel format indexes. --------------------------------------------------------------------------------} -procedure TsCustomNumFormatList.Sort; -begin - inherited Sort(@CompareNumFormatData); -end; - end. diff --git a/components/fpspreadsheet/fpsnumformatparser.pas b/components/fpspreadsheet/fpsnumformatparser.pas index abd92eb75..a6de8c392 100644 --- a/components/fpspreadsheet/fpsnumformatparser.pas +++ b/components/fpspreadsheet/fpsnumformatparser.pas @@ -7,7 +7,7 @@ unit fpsNumFormatParser; interface uses - SysUtils, fpstypes, fpspreadsheet; + Classes, SysUtils, fpstypes, fpspreadsheet; const @@ -22,47 +22,9 @@ const psErrQuoteExpected = 8; psAmbiguousSymbol = 9; -{ TsNumFormatParser } - type - TsNumFormatToken = (nftText, nftThSep, nftDecSep, - nftYear, nftMonth, nftDay, nftHour, nftMinute, nftSecond, nftMilliseconds, - nftAMPM, nftMonthMinute, nftDateTimeSep, - nftSign, nftSignBracket, - nftDigit, nftOptDigit, nftOptSpaceDigit, nftDecs, nftOptDec, - nftExpChar, nftExpSign, nftExpDigits, - nftPercent, // '%' - nftFracSymbol, // '/' - nftFracIntDigit, nftFracIntSpaceDigit, nftFracIntZeroDigit, // '#', '?', '0' - nftFracNumDigit, nftFracNumSpaceDigit, nftFracNumZeroDigit, - nftFracDenomDigit, nftFracDenomSpaceDigit, nftFracDenomZeroDigit, - 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 - Elements: TsNumFormatElements; - NumFormat: TsNumberFormat; - Decimals: Byte; - FracInt: Integer; - FracNumerator: Integer; - FracDenominator: Integer; - CurrencySymbol: String; - Color: TsColor; - end; - - TsNumFormatSections = array of TsNumFormatSection; + { TsNumFormatParser } TsNumFormatParser = class private @@ -72,8 +34,8 @@ type FStart: PChar; FEnd: PChar; FCurrSection: Integer; - FHasRedSection: Boolean; FStatus: Integer; + FDialect: TsNumFormatDialect; function GetCurrencySymbol: String; function GetDecimals: byte; function GetFracDenominator: Integer; @@ -125,28 +87,17 @@ type procedure FixMonthMinuteToken(ASection: Integer); // Format string function BuildFormatString(ADialect: TsNumFormatDialect): String; virtual; - function BuildFormatStringFromSection(ASection: Integer; - ADialect: TsNumFormatDialect): String; virtual; - // NumberFormat - procedure EvalNumFormatOfSection(ASection: Integer); + // Token analysis function GetTokenIntValueAt(AToken: TsNumFormatToken; ASection,AIndex: Integer): Integer; - function IsCurrencyAt(ASection: Integer; out ANumFormat: TsNumberFormat; - out ADecimals: byte; out ACurrencySymbol: String; out AColor: TsColor): Boolean; - function IsDateAt(ASection,AIndex: Integer; out ANumberFormat: TsNumberFormat; - var ANextIndex: Integer): Boolean; - function IsFractionAt(ASection,AIndex: Integer; - out AIntPart, ANumPart, ADenomPart, ANextIndex: Integer): Boolean; - function IsNumberAt(ASection,AIndex: Integer; out ANumberFormat: TsNumberFormat; + function IsNumberAt(ASection,AIndex: Integer; out ANumFormat: TsNumberFormat; out ADecimals: Byte; out ANextIndex: Integer): Boolean; function IsTextAt(AText: string; ASection, AIndex: Integer): Boolean; - function IsTimeAt(ASection,AIndex: Integer; out ANumberFormat: TsNumberFormat; - out ANextIndex: Integer): Boolean; function IsTokenAt(AToken: TsNumFormatToken; ASection,AIndex: Integer): Boolean; public constructor Create(AWorkbook: TsWorkbook; const AFormatString: String; - const ANumFormat: TsNumberFormat = nfGeneral); + ADialect: TsNumFormatDialect = nfdDefault); destructor Destroy; override; procedure ClearAll; function GetDateTimeCode(ASection: Integer): String; @@ -171,7 +122,7 @@ type implementation uses - TypInfo, StrUtils, LazUTF8, fpsutils, fpsCurrency; + TypInfo, LazUTF8, fpsutils, fpsCurrency; { TsNumFormatParser } @@ -182,19 +133,19 @@ uses because the format string might not contain the color information, and we extract it from the NumFormat in this case. } constructor TsNumFormatParser.Create(AWorkbook: TsWorkbook; - const AFormatString: String; const ANumFormat: TsNumberFormat = nfGeneral); + const AFormatString: String; ADialect: TsNumFormatDialect = nfdDefault); begin inherited Create; FCreateMethod := 0; FWorkbook := AWorkbook; - FHasRedSection := (ANumFormat = nfCurrencyRed); + FDialect := ADialect; Parse(AFormatString); + CheckSections; end; destructor TsNumFormatParser.Destroy; begin FSections := nil; -// ClearAll; inherited Destroy; end; @@ -290,97 +241,9 @@ var i: Integer; begin 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). } -function TsNumFormatParser.BuildFormatStringFromSection(ASection: Integer; - ADialect: TsNumFormatDialect): String; -var - element: TsNumFormatElement; - i: Integer; -begin - Result := ''; - - 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, nftDecSep: - Result := Result + element.TextValue; - nftDigit, nftFracIntZeroDigit, nftFracNumZeroDigit, nftFracDenomZeroDigit: - Result := Result + DupeString('0', element.IntValue); - nftOptDigit, nftOptDec, nftFracIntDigit, nftFracNumDigit, nftFracDenomDigit: - Result := Result + DupeString('#', element.IntValue); - nftOptSpaceDigit, nftFracIntSpaceDigit, nftFracNumSpaceDigit, nftFracDenomSpaceDigit: - Result := Result + DupeString('?', element.IntValue); - nftFracSymbol: - 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 begin - 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; + Result := BuildFormatStringFromSection(FSections[0], ADialect); + for i:=1 to High(FSections) do + Result := Result + ';' + BuildFormatStringFromSection(FSections[i], ADialect); end; end; @@ -388,14 +251,152 @@ procedure TsNumFormatParser.CheckSections; var i: Integer; begin - for i:=0 to Length(FSections)-1 do + for i:=0 to High(FSections) do CheckSection(i); + + if (Length(FSections) > 1) and (FSections[1].NumFormat = nfCurrencyRed) then + for i:=0 to High(FSections) do + if FSections[i].NumFormat = nfCurrency then + FSections[i].NumFormat := nfCurrencyRed; end; procedure TsNumFormatParser.CheckSection(ASection: Integer); +var + el, next: Integer; + section: PsNumFormatSection; + nfs: String; + nf: TsNumberFormat; + datetimeFormats: set of TsNumberformat; + f1,f2: Integer; + decs: Byte; begin - FixMonthMinuteToken(ASection); - EvalNumFormatOfSection(ASection); + if FStatus <> psOK then + exit; + + section := @FSections[ASection]; + section^.Kind := []; + + for el := 0 to High(section^.Elements) do + case section^.Elements[el].Token of + nftPercent: + section^.Kind := section^.Kind + [nfkPercent]; + nftExpChar: + section^.Kind := section^.Kind + [nfkExp]; + nftFracSymbol: + section^.Kind := section^.Kind + [nfkFraction]; + nftCurrSymbol: + begin + section^.Kind := section^.Kind + [nfkCurrency]; + section^.CurrencySymbol := section^.Elements[el].TextValue; + end; + nftYear, nftMonth, nftDay: + section^.Kind := section^.Kind + [nfkDate]; + nftHour, nftMinute, nftSecond, nftMilliseconds: + begin + section^.Kind := section^.Kind + [nfkTime]; + if section^.Elements[el].IntValue < 0 then + section^.Kind := section^.Kind + [nfkTimeInterval]; + end; + end; + + if (section^.Kind * [nfkDate, nfkTime] <> []) and + (section^.Kind * [nfkPercent, nfkExp, nfkCurrency, nfkFraction] <> []) then + begin + FStatus := psErrNoValidDateTimeFormat; + exit; + end; + + section^.NumFormat := nfCustom; + + if (section^.Kind * [nfkDate, nfkTime] <> []) then + begin + FixMonthMinuteToken(ASection); + nfs := FormatString[nfdDefault]; + if (nfkTimeInterval in section^.Kind) then + section^.NumFormat := nfTimeInterval + else + begin + datetimeFormats := [nfShortDateTime, nfLongDate, nfShortDate, nfLongTime, + nfShortTime, nfLongTimeAM, nfShortTimeAM, nfDayMonth, nfMonthYear]; + for nf in datetimeFormats do + if SameText(nfs, BuildDateTimeFormatString(nf, FWorkbook.FormatSettings)) then + begin + section^.NumFormat := nf; + break; + end; + end; + end else + begin + el := 0; + while el < Length(section^.Elements) do + begin + if IsNumberAt(ASection, el, nf, decs, next) then begin + section^.Decimals := decs; + if nf = nfFixedTh then begin + if (nfkCurrency in section^.Kind) then + section^.NumFormat := nfCurrency + else + section^.NumFormat := nfFixedTh + end else + begin + section^.NumFormat := nf; + if (nfkPercent in section^.Kind) then + section^.NumFormat := nfPercentage + else + if (nfkExp in section^.Kind) then + section^.NumFormat := nfExp + else + if (nfkCurrency in section^.Kind) then + section^.NumFormat := nfCurrency + else + if (nfkFraction in section^.Kind) and (decs = 0) then begin + f1 := section^.Elements[el].IntValue; // int part or numerator + el := next; + while IsTokenAt(nftSpace, ASection, el) or IsTextAt(' ', ASection, el) do + inc(el); + if IsTokenAt(nftFracSymbol, ASection, el) then begin + inc(el); + while IsTokenAt(nftSpace, ASection, el) or IsTextAt(' ', aSection, el) do + inc(el); + if IsNumberAt(ASection, el, nf, decs, next) and (nf in [nfFixed, nfFraction]) and (decs = 0) then + begin + section^.FracInt := 0; + section^.FracNumerator := f1; + section^.FracDenominator := section^.Elements[el].IntValue; + section^.NumFormat := nfFraction; + end; + end else + if IsNumberAt(ASection, el, nf, decs, next) and (nf in [nfFixed, nfFraction]) and (decs = 0) then + begin + f2 := section^.Elements[el].IntValue; + el := next; + while IsTokenAt(nftSpace, ASection, el) or IsTextAt(' ', ASection, el) do + inc(el); + if IsTokenAt(nftFracSymbol, ASection, el) then + begin + inc(el); + while IsTokenAt(nftSpace, ASection, el) or IsTextAt(' ', ASection, el) do + inc(el); + if IsNumberAt(ASection, el, nf, decs, next) and (nf in [nfFixed, nfFraction]) and (decs=0) then + begin + section^.FracInt := f1; + section^.FracNumerator := f2; + section^.FracDenominator := section^.Elements[el].IntValue; + section^.NumFormat := nfFraction; + end; + end; + end; + end; + end; + break; + end else + if IsTokenAt(nftColor, ASection, el) then + section^.Color := section^.Elements[el].IntValue; + inc(el); + end; + if (section^.NumFormat = nfCurrency) and (section^.Color = scRed) then + section^.NumFormat := nfCurrencyRed; + end; end; procedure TsNumFormatParser.ClearAll; @@ -535,117 +536,8 @@ begin end; function TsNumFormatParser.GetFormatString(ADialect: TsNumFormatDialect): String; -var - i: Integer; begin - Result := ''; - if Length(FSections) > 0 then begin - Result := BuildFormatStringFromSection(0, ADialect); - for i:=1 to High(FSections) do - Result := Result + ';' + BuildFormatStringFromSection(i, ADialect); - end; -end; - -procedure TsNumFormatParser.EvalNumFormatOfSection(ASection: Integer); -var - nf, nf1: TsNumberFormat; - next: Integer = 0; - decs: Byte; - intPart, numPart, denomPart: Integer; - cs: String; - clr: TsColor; - tok: TsNumFormatToken; -begin - nf := nfCustom; - decs := 0; - cs := ''; - clr := scNotDefined; - - with FSections[ASection] do begin - if Length(Elements) = 0 then begin - FSections[ASection].NumFormat := nfGeneral; - exit; - end; - - // Look for number formats (note: fractions are rarely used --> at end) - if IsNumberAt(ASection, 0, nf, decs, next) then begin - // nfFixed, nfFixedTh - if next = Length(Elements) then - begin - FSections[ASection].NumFormat := nf; - FSections[ASection].Decimals := decs; - exit; - end; - // nfPercentage - if IsTokenAt(nftPercent, ASection, next) and (next+1 = Length(Elements)) - then begin - FSections[ASection].NumFormat := nfPercentage; - FSections[ASection].Decimals := decs; - 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 nf = nfFixed then - begin - FSections[ASection].NumFormat := nfExp; - FSections[ASection].Decimals := decs; - exit; - end; - end; - end; - end; - - // Currency? - if IsCurrencyAt(ASection, nf, decs, cs, clr) then - begin - FSections[ASection].NumFormat := nf; - FSections[ASection].Decimals := decs; - FSections[ASection].CurrencySymbol := cs; - FSections[ASection].Color := clr; - exit; - end; - - // Look for date formats - if IsDateAt(ASection, 0, nf, next) then begin - if (next = Length(Elements)) then - begin - FSections[ASection].NumFormat := nf; - exit; - end; - if IsTokenAt(nftSpace, ASection, next) and IsTimeAt(ASection, next+1, nf1, next) and - (next = Length(Elements)) - then begin - if (nf = nfShortDate) and (nf1 = nfShortTime) then - FSections[ASection].NumFormat := nfShortDateTime; - end; - exit; - end; - - // Look for time formats - if IsTimeAt(ASection, 0, nf, next) then - if next = Length(Elements) then - begin - FSections[ASection].NumFormat := nf; - exit; - end; - - // Look for fractions - if IsFractionAt(ASection, 0, intPart, numPart, denomPart, next) then - if next = Length(Elements) then - begin - FSections[ASection].NumFormat := nfFraction; - FSections[ASection].FracInt := intPart; - FSections[ASection].FracNumerator := numPart; - FSections[ASection].FracDenominator := denomPart; - exit; - end; - end; - - // If we get here it must be a custom format. - FSections[ASection].NumFormat := nfCustom; + Result := BuildFormatString(ADialect); end; { Extracts the currency symbol form the formatting sections. It is assumed that @@ -787,303 +679,83 @@ begin Result := -1; end; -{ 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: Integer; - out ANumFormat: TsNumberFormat; out ADecimals: byte; - out ACurrencySymbol: String; out AColor: TsColor): Boolean; -var - hasCurrSymbol: Boolean; - hasColor: Boolean; - el: Integer; -begin - Result := false; - - ANumFormat := nfCustom; - ACurrencySymbol := ''; - ADecimals := 0; - AColor := scNotDefined; - hasColor := false; - hasCurrSymbol := false; - - // Looking for the currency symbol: it is the unique identifier of the - // currency format. - for el := 0 to High(FSections[ASection].Elements) do - if FSections[ASection].Elements[el].Token = nftCurrSymbol then begin - Result := true; - break; - end; - - if not Result then - exit; - - { When the format string comes from fpc it does not contain a color token. - Color would be lost when saving. Therefore, we take the color from the - knowledge of the NumFormat passed on creation: nfCurrencyRed has color red - in the second section! } - if (ASection = 1) and FHasRedSection then - AColor := scRed; - - // Now that we know that it is a currency format analyze the elements again - // and determine color, decimals and currency symbol. - el := 0; - while (el < Length(FSections[ASection].Elements)) do begin - case FSections[ASection].Elements[el].Token of - nftColor: - begin - AColor := FSections[ASection].Elements[el].IntValue; - hasColor := true; - end; - nftRepeat: - ; - nftCurrSymbol: - begin - ACurrencySymbol := FSections[ASection].Elements[el].TextValue; - hasCurrSymbol := true; - end; - nftOptDigit: - if IsNumberAt(ASection, el, ANumFormat, ADecimals, el) then - dec(el) - else begin - Result := false; - exit; - end; - nftDigit: - if IsNumberAt(ASection, el, ANumFormat, ADecimals, el) then - dec(el) - else begin - Result := false; - exit; - end; - end; - inc(el); - end; - - if (ASection = 1) and FHasRedSection and not hasColor then - InsertElement(ASection, 0, nftColor, scRed); - - Result := hasCurrSymbol and ((ANumFormat = nfFixedTh) or (ASection = 2)); - if Result then begin - if AColor = scNotDefined then ANumFormat := nfCurrency else - if AColor = scRed then ANumFormat := nfCurrencyRed; - end else - ANumFormat := nfCustom; -end; - -function TsNumFormatParser.IsDateAt(ASection,AIndex: Integer; - out 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; - -begin - if FWorkbook = nil then begin - Result := false; - exit; - end; - - // 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 - 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; - -function TsNumFormatParser.IsFractionAt(ASection,AIndex: Integer; - out AIntPart, ANumPart, ADenomPart, ANextIndex: Integer): Boolean; -var - tok: TsNumFormatToken; section: TsNumFormatSection; begin + for section in FSections do + if section.Kind * [nfkDate, nfkTime] <> [] then + begin + Result := true; + exit; + end; Result := false; - AIntPart := 0; - ANumPart := 0; - ADenomPart := 0; - ANextIndex := MaxInt; - - if ASection > High(FSections) then - exit; - section := FSections[ASection]; - if AIndex > High(section.Elements) then - exit; - - // integer part of the fraction - tok := section.Elements[AIndex].Token; - if tok in [nftFracIntDigit, nftFracIntSpaceDigit, nftFracIntZeroDigit] then - begin - AIntPart := section.Elements[AIndex].IntValue; - inc(AIndex); - end; - - // Skip space(s) - while (AIndex <= High(section.Elements)) and - (IsTokenAt(nftSpace, ASection, AIndex) or IsTextAt(' ', ASection, AIndex)) - do - inc(AIndex); - if AIndex > High(section.Elements) then - exit; - - // numerator - tok := section.Elements[AIndex].Token; - if tok in [nftFracNumDigit, nftFracNumSpaceDigit, nftFracNumZeroDigit] then - ANumPart := section.Elements[AIndex].IntValue - else - exit; - - // Skip space(s) and fraction symbol - inc(AIndex); - while (AIndex <= High(section.Elements)) and - (IsTokenAt(nftSpace, ASection, AIndex) or - IsTextAt(' ', ASection, AIndex) or - IsTokenAt(nftFracSymbol, ASection, AIndex)) - do - inc(AIndex); - - // denominator - tok := section.Elements[AIndex].Token; - if tok in [nftFracDenomDigit, nftFracDenomSpaceDigit, nftFracDenomZeroDigit] then - begin - ADenomPart := section.Elements[AIndex].IntValue; - ANextIndex := AIndex + 1; - Result := true; - end; 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. - NOTE: Fraction format is not checked here --> see: IsFractionAt } -function TsNumFormatParser.IsNumberAt(ASection,AIndex: Integer; - out ANumberFormat: TsNumberFormat; out ADecimals: Byte; +function TsNumFormatParser.IsNumberAt(ASection, AIndex: Integer; + out ANumFormat: TsNumberFormat; out ADecimals: Byte; out ANextIndex: Integer): Boolean; var - i: Integer; + token: TsNumFormatToken; begin - Result := false; - ANumberFormat := nfGeneral; + if (ASection > High(FSections)) or (AIndex > High(FSections[ASection].Elements)) + then begin + Result := false; + ANextIndex := AIndex; + exit; + end; + + Result := true; + ANumFormat := nfCustom; ADecimals := 0; - ANextIndex := MaxInt; - // 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) then begin // '#' - if IsTokenAt(nftThSep, ASection, AIndex+1) and // ',' - (GetTokenIntValueAt(nftOptDigit, ASection, AIndex+2) = 2) and // '##' - (GetTokenIntValueAt(nftDigit, ASection, AIndex+3) = 1) // '0' - then begin - if IsTokenAt(nftDecSep, ASection, AIndex+4) and // '.' - IsTokenAt(nftDecs, ASection, AIndex+5) // count of decimals - then begin - // This is the case with decimal separator, like "#,##0.000" - Result := true; - ANumberFormat := nfFixedTh; - ADecimals := FSections[ASection].Elements[AIndex+5].IntValue; - ANextIndex := AIndex + 6; - end else - if not IsTokenAt(nftDecSep, ASection, AIndex+4) then begin - // and this is without decimal separator, "#,##0" - result := true; - ANumberFormat := nfFixedTh; - ADecimals := 0; - ANextIndex := AIndex + 4; + token := FSections[ASection].Elements[AIndex].Token; + + if token in [nftFracNumOptDigit, nftFracNumZeroDigit, nftFracNumSpaceDigit, + nftFracDenomOptDigit, nftFracDenomZeroDigit, nftFracDenomSpaceDigit] then + begin + ANumFormat := nfFraction; + ANextIndex := AIndex + 1; + exit; + end; + + if (token = nftIntTh) and (FSections[ASection].Elements[AIndex].IntValue = 1) then // '#,##0' + ANumFormat := nfFixedTh + else + if (token = nftIntZeroDigit) and (FSections[ASection].Elements[AIndex].IntValue = 1) then // '0' + ANumFormat := nfFixed; + + if (token in [nftIntTh, nftIntZeroDigit, nftIntOptDigit, nftIntSpaceDigit]) then + begin + if IsTokenAt(nftDecSep, ASection, AIndex+1) then + begin + if AIndex + 2 < Length(FSections[ASection].Elements) then + begin + token := FSections[ASection].Elements[AIndex+2].Token; + if (token in [nftZeroDecs, nftOptDecs, nftSpaceDecs]) then + begin + ANextIndex := AIndex + 3; + ADecimals := FSections[ASection].Elements[AIndex+2].IntValue; + if (token <> nftZeroDecs) then + ANumFormat := nfCustom; + exit; + end; end; + end else + if IsTokenAt(nftSpace, ASection, AIndex+1) then + begin + ANumFormat := nfFraction; + ANextIndex := AIndex + 1; + exit; + end else + begin + ANextIndex := AIndex + 1; + exit; end; end; + + ANextIndex := AIndex; + Result := false; end; function TsNumFormatParser.IsTextAt(AText: String; ASection, AIndex: Integer): Boolean; @@ -1092,153 +764,18 @@ begin (FSections[ASection].Elements[AIndex].TextValue = AText); end; -function TsNumFormatParser.IsTimeAt(ASection,AIndex: Integer; - out ANumberFormat: TsNumberFormat; out ANextIndex: Integer): Boolean; - - function CheckFormat(AFmtStr: String; out idx: Integer; - out 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 := i >= Length(AFmtStr); //true; - end; - -var - AMPM, isInterval: Boolean; - i: Integer; - fmt: String; -begin - if FWorkbook = nil then begin - Result := false; - exit; - end; - - 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 := FWorkbook.FormatSettings.ShortTimeFormat; - 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; - { Returns true if the format elements contain only time, no date tokens. } function TsNumFormatParser.IsTimeFormat: Boolean; var - section: Integer; - elem: Integer; + section: TsNumFormatSection; begin + for section in FSections do + if (nfkTime in section.Kind) then + begin + Result := true; + exit; + end; Result := false; - for section := 0 to High(FSections) do - for elem := 0 to High(FSections[section].Elements) do - if FSections[section].Elements[elem].Token in [nftHour, nftMinute, nftSecond] - then begin - Result := true; - end else - if FSections[section].Elements[elem].Token in - [nftYear, nftMonth, nftDay, nftExpChar, nftCurrSymbol] - then begin - Result := false; - exit; - end; end; function TsNumFormatParser.IsTokenAt(AToken: TsNumFormatToken; @@ -1256,7 +793,7 @@ var 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 + if FSections[j].Elements[i].Token = nftZeroDecs then if FSections[j].Elements[i].IntValue > 0 then FSections[j].Elements[i].IntValue := 2; end; @@ -1304,8 +841,9 @@ end; procedure TsNumFormatParser.Parse(const AFormatString: String); begin FStatus := psOK; + AddSection; - if (AFormatString = '') or (lowercase(AFormatString) = 'general') then + if (AFormatString = '') or SameText(AFormatString, 'General') then exit; FStart := @AFormatString[1]; @@ -1322,8 +860,6 @@ begin end; FToken := NextToken; end; - - CheckSections; end; { Scans an AM/PM sequence (or AMPM or A/P). @@ -1331,6 +867,7 @@ end; procedure TsNumFormatParser.ScanAMPM; var s: String; + el: Integer; begin s := ''; while (FCurrent < FEnd) do begin @@ -1340,7 +877,18 @@ begin break; FToken := NextToken; end; - AddElement(nftAMPM, s); + if s <> '' then + begin + AddElement(nftAMPM, s); + // Tag the hour element for AM/PM format needed + el := High(FSections[FCurrSection].Elements)-1; + for el := High(FSections[FCurrSection].Elements)-1 downto 0 do + if FSections[FCurrSection].Elements[el].Token = nftHour then + begin + FSections[FCurrSection].Elements[el].TextValue := 'AM'; + break; + end; + end; end; { Counts the number of characters equal to ATestChar. Stops at the next @@ -1365,12 +913,17 @@ var s: String; n: Integer; prevtoken: Char; + isText: Boolean; begin s := ''; + isText := false; FToken := NextToken; // Cursor was at '[' while (FCurrent < FEnd) and (FStatus = psOK) do begin case FToken of 'h', 'H', 'm', 'M', 'n', 'N', 's', 'S': + if isText then + s := s + FToken + else begin prevtoken := FToken; ScanAndCount(FToken, n); @@ -1411,6 +964,7 @@ begin else s := s + FToken; + isText := true; end; FToken := NextToken; end; @@ -1485,14 +1039,16 @@ begin s := s + FToken; FToken := NextToken; end; - AddElement(nftCurrSymbol, s); + if s <> '' then + 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); + if s <> '' then + AddElement(nftCountry, s); end; end; @@ -1563,7 +1119,7 @@ begin ScanAMPM; ',', '-': begin - Addelement(nftText, FToken); + AddElement(nftText, FToken); FToken := NextToken; end else @@ -1622,6 +1178,8 @@ begin AddSection; Exit; end; + else + AddElement(nftText, FToken); end; FToken := NextToken; end; @@ -1634,7 +1192,8 @@ var hasDecSep: Boolean; isFrac: Boolean; n: Integer; - elem: Integer; + el: Integer; + savedCurrent: PChar; begin hasDecSep := false; isFrac := false; @@ -1645,16 +1204,73 @@ begin AddElement(nftDecSep, '.'); hasDecSep := true; end; + '#': begin + ScanAndCount('#', n); + savedCurrent := FCurrent; + if not (hasDecSep or isFrac) and (n = 1) and (FToken = ',') then + begin + FToken := NextToken; + ScanAndCount('#', n); + case n of + 0: begin + FToken := PrevToken; + ScanAndCount('0', n); + FToken := prevToken; + if n = 3 then + AddElement(nftIntTh, 3) + else + FCurrent := savedCurrent; + end; + 1: begin + ScanAndCount('0', n); + FToken := prevToken; + if n = 2 then + AddElement(nftIntTh, 2) + else + FCurrent := savedCurrent; + end; + 2: begin + ScanAndCount('0', n); + FToken := prevToken; + if (n = 1) then + AddElement(nftIntTh, 1) + else + FCurrent := savedCurrent; + end; + end; + end else + begin + FToken := PrevToken; + if isFrac then + AddElement(nftFracDenomOptDigit, n) + else + if hasDecSep then + AddElement(nftOptDecs, n) + else + AddElement(nftIntOptDigit, n); + end; + end; '0': begin ScanAndCount('0', n); FToken := PrevToken; if hasDecSep then - AddElement(nftDecs, n) + AddElement(nftZeroDecs, n) else if isFrac then AddElement(nftFracDenomZeroDigit, n) else - Addelement(nftDigit, n); + AddElement(nftIntZeroDigit, n); + end; + '?': begin + ScanAndCount('?', n); + FToken := PrevToken; + if hasDecSep then + AddElement(nftSpaceDecs, n) + else + if isFrac then + AddElement(nftFracDenomSpaceDigit, n) + else + AddElement(nftIntSpaceDigit, n); end; 'E', 'e': begin @@ -1671,49 +1287,31 @@ begin end; '+', '-': AddElement(nftSign, FToken); - '#': begin - ScanAndCount('#', n); - FToken := PrevToken; - if isFrac then - AddElement(nftFracDenomDigit, n) - else - AddElement(nftOptDigit, n); - end; - '?': begin - ScanAndCount('?', n); - FToken := PrevToken; - if isFrac then - AddElement(nftFracDenomSpaceDigit, n) - else - AddElement(nftOptSpaceDigit, n); - end; '%': AddElement(nftPercent, FToken); '/': begin isFrac := true; AddElement(nftFracSymbol, FToken); - // go back and replace correct token for numerator (n=0) and integer part (n=1) - n := 0; - elem := High(FSections[FCurrSection].Elements); - while elem > 0 do begin - dec(elem); - case FSections[FCurrSection].Elements[elem].Token of - nftOptDigit: - if n = 0 then - FSections[FCurrSection].Elements[elem].Token := nftFracNumDigit - else - FSections[FCurrSection].Elements[elem].Token := nftFracIntDigit; - nftOptSpaceDigit: - if n = 0 then - FSections[FCurrSection].Elements[elem].Token := nftFracNumSpaceDigit - else - FSections[FCurrSection].Elements[elem].Token := nftFracIntSpaceDigit; - nftDigit: - if n = 0 then - FSections[FCurrSection].Elements[elem].Token := nftFracNumZeroDigit - else - FSections[FCurrSection].Elements[elem].Token := nftFracIntZeroDigit; + // go back and replace correct token for numerator + el := High(FSections[FCurrSection].Elements); + while el > 0 do begin + dec(el); + case FSections[FCurrSection].Elements[el].Token of + nftIntOptDigit: + begin + FSections[FCurrSection].Elements[el].Token := nftFracNumOptDigit; + break; + end; + nftIntSpaceDigit: + begin + FSections[FCurrSection].Elements[el].Token := nftFracNumSpaceDigit; + break; + end; + nftIntZeroDigit: + begin + FSections[FCurrSection].Elements[el].Token := nftFracNumZeroDigit; + break; + end; end; - inc(n); end; end; @@ -1759,18 +1357,19 @@ begin i := n-1; while (i > -1) do begin case FSections[j].Elements[i].Token of - nftDigit: + nftIntOptDigit, nftIntZeroDigit, nftIntSpaceDigit, nftIntTh: // no decimals so far --> add decimal separator and decimals element if (AValue > 0) then begin // Don't use "AddElements" because nfCurrency etc have elements after the number. InsertElement(j, i, nftDecSep, '.'); - InsertElement(j, i+1, nftDecs, AValue); + InsertElement(j, i+1, nftZeroDecs, AValue); break; end; - nftDecs: + nftZeroDecs, nftOptDecs, nftSpaceDecs: if AValue > 0 then begin // decimals are already used, just replace value of decimal places FSections[j].Elements[i].IntValue := AValue; + FSections[j].Elements[i].Token := nftZeroDecs; break; end else begin // No decimals any more: delete decs and decsep elements diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 6540331b1..8639f827a 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -45,23 +45,17 @@ type TDateMode=( dm1899 {default for ODF; almost same as Excel 1900}, dm1900 {StarCalc legacy only}, - dm1904 {e.g. Quattro Pro,Mac Excel compatibility} + dm1904 {e.g. Quattro Pro, Mac Excel compatibility} ); - { TsSpreadOpenDocNumFormatList } - - TsSpreadOpenDocNumFormatList = class(TsCustomNumFormatList) - protected - procedure AddBuiltinFormats; override; - public - end; - { TsSpreadOpenDocNumFormatParser } TsSpreadOpenDocNumFormatParser = class(TsNumFormatParser) + { private function BuildCurrencyXMLAsString(ASection: Integer): String; function BuildDateTimeXMLAsString(ASection: Integer; out AIsTimeOnly, AIsInterval: Boolean): String; + } protected function BuildXMLAsStringFromSection(ASection: Integer; AFormatName: String): String; @@ -77,7 +71,7 @@ type FColumnList: TFPList; FRowStyleList: TFPList; FRowList: TFPList; - FVolatileNumFmtList: TsCustomNumFormatList; +// FVolatileNumFmtList: TStringList; FDateMode: TDateMode; // Applies internally stored column widths to current worksheet procedure ApplyColWidths; @@ -91,6 +85,7 @@ type // Searches a column style by its column index or its name in the StyleList function FindColumnByCol(AColIndex: Integer): Integer; function FindColStyleByName(AStyleName: String): integer; + function FindNumFormatByName(ANumFmtName: String): Integer; function FindRowStyleByName(AStyleName: String): Integer; procedure ReadColumns(ATableNode: TDOMNode); procedure ReadColumnStyle(AStyleNode: TDOMNode); @@ -102,7 +97,7 @@ type protected FPointSeparatorSettings: TFormatSettings; - procedure CreateNumFormatList; override; + procedure AddBuiltinNumFormats; override; procedure ReadNumFormats(AStylesNode: TDOMNode); procedure ReadSettings(AOfficeSettingsNode: TDOMNode); procedure ReadStyles(AStylesNode: TDOMNode); @@ -158,11 +153,11 @@ type FSMeta, FSSettings, FSStyles, FSContent, FSMimeType, FSMetaInfManifest: TStream; { Helpers } - procedure CreateNumFormatList; override; + procedure AddBuiltinNumFormats; override; procedure CreateStreams; procedure DestroyStreams; procedure ListAllColumnStyles; - procedure ListAllNumFormats; override; + procedure ListAllNumFormats(ADialect: TsNumFormatDialect); override; procedure ListAllRowStyles; procedure ResetStreams; @@ -303,16 +298,11 @@ type *) -{ TsSpreadOpenDocNumFormatList } - -procedure TsSpreadOpenDocNumFormatList.AddBuiltinFormats; -begin - AddFormat('N0', nfGeneral, ''); -end; - - -{ TsSpreadOpenDocNumFormatParser } +{------------------------------------------------------------------------------} +{ TsSpreadOpenDocNumFormatParser } +{------------------------------------------------------------------------------} + (* function TsSpreadOpenDocNumFormatParser.BuildCurrencyXMLAsString(ASection: Integer): String; var el, next: Integer; @@ -320,6 +310,7 @@ var nf: TsNumberFormat; decs: byte; s: String; + n: Integer; begin Result := ''; el := 0; @@ -353,20 +344,30 @@ begin ''; inc(el); end; - nftOptDigit: + nftIntTh: if IsNumberAt(ASection, el, nf, decs, next) then begin - Result := Result + - ' '; + Result := Result + Format( + ' ', + [decs, Elements[el].IntValue]); el := next; end; - nftDigit: + nftIntZeroDigit: + if IsNumberAt(ASection, el, nf, decs, next) then + begin + Result := Result + Format( + ' ', + [decs, elements[el].IntValue]); + el := next; + end; + nftIntOptDigit, nftIntSpaceDigit: // To do: SpaceDigit not correct here if IsNumberAt(ASection, el, nf, decs, next) then begin Result := Result + ' '; + '" number:min-integer-digits="0" />'; el := next; end; nftRepeat: @@ -484,7 +485,7 @@ begin end; end; end; - +*) function TsSpreadOpenDocNumFormatParser.BuildXMLAsString(AFormatName: String): String; var i: Integer; @@ -501,41 +502,34 @@ end; function TsSpreadOpenDocNumFormatParser.BuildXMLAsStringFromSection( ASection: Integer; AFormatName: String): String; var - nf : TsNumberFormat; - decs: Byte; - expdig: Integer; - curr, next: Integer; - sGrouping: String; - sColor: String; - sStyleMap: String; + n: Integer; + el, nEl: Integer; ns: Integer; clr: TsColorvalue; - el: Integer; - s: String; - isTimeOnly: Boolean; - isInterval: Boolean; - intPart, numPart, denomPart: Integer; + mask: String; + timeIntervalStr: String; + styleMapStr: String; begin Result := ''; - sGrouping := ''; - sColor := ''; - sStyleMap := ''; ns := Length(FSections); if (ns = 0) then exit; + styleMapStr := ''; + timeIntervalStr := ''; + if (ns > 1) then begin // The file corresponding to the last section contains the styleMap. if (ASection = ns - 1) then case ns of - 2: sStyleMap := + 2: styleMapStr := ''; // >= 0 - 3: sStyleMap := + 3: styleMapStr := ' 0 'style:condition="value()>0" />' + @@ -551,14 +545,216 @@ begin with FSections[ASection] do begin - curr := 0; - if IsTokenAt(nftColor, ASection, 0) then - begin - clr := FWorkbook.GetPaletteColor(Elements[0].IntValue); - sColor := '' + LineEnding; - curr := 1; + nEl := Length(Elements); + el := 0; + while (el < nEl) do begin + case Elements[el].Token of + nftColor: + begin + clr := FWorkbook.GetPaletteColor(Elements[el].IntValue); + Result := Result + ''; + end; + + nftSign, nftSignBracket, nftText, nftSpace: + if Elements[el].TextValue = ' ' then + Result := Result + '' + else + Result := Result + '' + Elements[el].TextValue + ''; + + nftPercent: + Result := Result + '%'; + + nftCurrSymbol: + Result := Result + '' + Elements[el].TextValue + ''; + + nftIntTh: + begin + Result := Result + ' nftDecSep) then + Result := Result + ' number:decimal-places="0"'; + Result := Result + ' />'; + end; + + nftFracNumZeroDigit, nftFracNumOptDigit, nftFracNumSpaceDigit: + if (el+2 < nel) and (Elements[el+1].Token = nftFracSymbol) then + begin + Result := Result + + ''; + inc(el, 2); + end; + + nftIntZeroDigit, nftIntOptDigit, nftIntSpaceDigit: + begin + // Mixed fraction + if (el+4 < nel) and (Elements[el+1].Token = nftSpace) and (Elements[el+3].Token = nftFracSymbol) + then begin + Result := Result + + ''; + inc(el, 4); + end + else + // Scientific, no decimals + if (el+3 < nel) and (Elements[el+1].Token = nftExpChar) then + begin + Result := Result + ''; + inc(el, 3); + end + else + // Scientific, with decimals + if (el+5 < nel) and (Elements[el+1].Token = nftDecSep) and (Elements[el+3].Token = nftExpChar) + then begin + Result := Result + ''; + inc(el, 5); + end + else + // Standard decimal number + if (el+2 < nel) and (Elements[el+1].Token = nftDecSep) then + begin + Result := Result + ''; + inc(el, 2); + end + else + // Standard integer + if (el = nel) or (Elements[el+1].Token <> nftDecSep) then + begin + Result := Result + ''; + end; + end; + + nftYear: + if Elements[el].IntValue > 2 then + Result := Result + '' + else + Result := Result + ''; + + nftMonth: + case Elements[el].IntValue of + 1: Result := Result + ''; + 2: Result := Result + ''; + 3: Result := Result + ''; + 4: Result := Result + ''; + end; + + nftDay: + case Elements[el].IntValue of + 1: Result := Result + ''; + 2: Result := Result + ''; + 3: Result := Result + ''; + 4: Result := Result + ''; + end; + + nftHour: + begin + case abs(Elements[el].IntValue) of + 1: Result := Result + ''; + 2: Result := Result + ''; + end; + if Elements[el].IntValue < 0 then + timeIntervalStr := ' number:truncate-on-overflow="false"'; + end; + + nftMinute: + begin + case abs(Elements[el].IntValue) of + 1: Result := Result + ''; + 2: Result := Result + ''; + end; + if Elements[el].IntValue < 0 then + timeIntervalStr := ' number:truncate-on-overflow="false"'; + end; + + nftSecond: + begin + case abs(Elements[el].IntValue) of + 1: Result := Result + ''; + 2: Result := Result + ''; + end; + if Elements[el].IntValue < 0 then + timeIntervalStr := ' number:truncate-on-overflow="false"'; + end; + + nftMilliseconds: + ; // ??? + + nftAMPM: + Result := Result + ''; + + nftDateTimeSep: + case Elements[el].TextValue of + '/': Result := Result + '' + FWorkbook.FormatSettings.DateSeparator + ''; + ':': Result := Result + '' + FWorkbook.FormatSettings.TimeSeparator + ''; + ' ': Result := Result + ''; + else Result := Result + '' + Elements[el].TextValue + ''; + end; + end; + + inc(el); end; - if IsNumberAt(ASection, curr, nf, decs, next) then + + if (nfkPercent in Kind) then + mask := '%s%s' + else + if (nfkCurrency in Kind) then + mask := '%s%s' + else + if (nfkDate in Kind) then + mask := '%s%s' + else + if (Kind * [nfkDate, nfkTime] = [nfkTime]) then + mask := '%s%s' + else + mask := '%s%s'; + + Result := Format(mask, [AFormatName, TimeIntervalStr, Result, StyleMapStr]); + end; +end; +(* + + if IsTokenAt(nftColor, ASection, el) then + begin + clr := FWorkbook.GetPaletteColor(Elements[el].IntValue); + sColor := '' + LineEnding; + el := 1; + end; + + // Find start of number format code + while (el < Length(Elements)) and not IsNumberAt(ASection, el, nf, decs, next) do + inc(el); + + if IsNumberAt(ASection, el, nf, decs, next) then begin if nf = nfFixedTh then sGrouping := 'number:grouping="true" '; @@ -579,7 +775,7 @@ begin end; // nfPercentage - if IsTokenAt(nftPercent, ASection, next) and (next+1 = Length(Elements)) then + if (nfkPercent in Kind) then begin Result := '' + @@ -610,7 +806,7 @@ begin exit; Result := '' + - sColor + + sColor + '' + @@ -618,95 +814,68 @@ begin ''; exit; end; + + // nfFraction + if (nf in [nfFixed, nfFraction]) and (nfkFraction in Kind) and (decs = 0) then + begin + if IsTokenAt(nftIntOptDigit, ASection, el) then + Result := + '' + + sColor + + '' + + '' + else + Result := + '' + + sColor + + '' + + ''; + exit; + end; + + // nfCurrency + if (nfkCurrency in Kind) then + begin + Result := + '' + + BuildCurrencyXMLAsString(ASection) + + sStyleMap + + ''; + exit; + end; end; - // nfFraction - if IsFractionAt(ASection, curr, intPart, numPart, denomPart, next) - then begin - Result := - '' + - sColor + - ' 0 then + // If the program gets here the format can only be date/time. + if (Kind * [nfkDate, nfkTime] <> []) then + begin + s := BuildDateTimeXMLAsString(ASection, isTimeOnly, isInterval); + if isTimeOnly then + begin Result := Result + - 'number:min-integer-digits="' + IntToStr(intPart) + '" '; - Result := Result + - 'number:min-numerator-digits="' + IntToStr(numPart) + '" ' + - 'number:min-denominator-digits="' + IntToStr(denomPart) + '" ' + - '/>' + - ''; + '' + + s + + sStylemap + + ''; + end else + Result := Result + + '' + + s + + sStylemap + + ''; exit; end; - - // If the program gets here the format can only be Currency or date/time. - el := 0; - decs := 0; - while el < Length(Elements) do - begin - case Elements[el].Token of - nftDecs: - decs := Elements[el].IntValue; // ??? - - nftExpChar: - // nfSci: not supported by ods, use nfExp instead. - begin - while el < Length(Elements) do - begin - if Elements[el].Token = nftExpDigits then - begin - expdig := Elements[el].IntValue; - Result := - '' + - sColor + - '' + - sStylemap + - ''; - exit; - end; - inc(el); - end; - exit; - end; - - // Currency - nftCurrSymbol: - begin - Result := - '' + - BuildCurrencyXMLAsString(ASection) + - sStyleMap + - ''; - exit; - end; - - // date/time - nftYear, nftMonth, nftDay, nftHour, nftMinute, nftSecond: - begin - s := BuildDateTimeXMLAsString(ASection, isTimeOnly, isInterval); - if isTimeOnly then - begin - Result := Result + - '' + - s + - ''; - end else - Result := Result + - '' + - s + - ''; - exit; - end; - end; - inc(el); - end; - end; end; +*) { TsSpreadOpenDocReader } @@ -724,7 +893,7 @@ begin FColumnList := TFPList.Create; FRowStyleList := TFPList.Create; FRowList := TFPList.Create; - FVolatileNumFmtList := TsCustomNumFormatList.Create(Workbook); +// FVolatileNumFmtList := TStringList.Create; // Set up the default palette in order to have the default color names correct. Workbook.UseDefaultPalette; // Initial base date in case it won't be read from file @@ -746,11 +915,18 @@ begin for j := FRowStyleList.Count-1 downto 0 do TObject(FRowStyleList[j]).Free; FRowStyleList.Free; - FVolatileNumFmtList.Free; // automatically destroys its items. + +// FVolatileNumFmtList.Free; inherited Destroy; end; +procedure TsSpreadOpenDocReader.AddBuiltinNumFormats; +begin + FNumFormatList.Clear; + FNumFormatList.Add('N0:'); +end; + { Creates for each non-default column width stored internally in FColumnList a TCol record in the current worksheet. } procedure TsSpreadOpenDocReader.ApplyColWidths; @@ -816,14 +992,6 @@ begin Result := true; end; -{ Creates the correct version of the number format list - suited for ODS file formats. } -procedure TsSpreadOpenDocReader.CreateNumFormatList; -begin - FreeAndNil(FNumFormatList); - FNumFormatList := TsSpreadOpenDocNumFormatList.Create(Workbook); -end; - { Extracts a boolean value from a "boolean" cell node. Is called from ReadBoolean } function TsSpreadOpenDocReader.ExtractBoolFromNode(ANode: TDOMNode): Boolean; @@ -946,6 +1114,14 @@ begin Result := -1; end; +function TsSpreadOpenDocReader.FindNumFormatByName(ANumFmtName: String): Integer; +begin + for Result := 0 to FNumFormatList.Count-1 do + if pos(ANumFmtName+':', FNumFormatList[Result]) = 1 then + exit; + Result := -1; +end; + function TsSpreadOpenDocReader.FindRowStyleByName(AStyleName: String): Integer; begin for Result := 0 to FRowStyleList.Count-1 do @@ -1577,6 +1753,7 @@ var styleName: String; cell: PCell; fmt: PsCellFormat; + numFmt: TsNumFormatParams; begin if FIsVirtualMode then begin @@ -1599,15 +1776,16 @@ begin styleName := GetAttrValue(ACellNode, 'table:style-name'); ApplyStyleToCell(cell, stylename); fmt := Workbook.GetPointerToCellFormat(cell^.FormatIndex); + numFmt := Workbook.GetNumberFormat(fmt^.NumberFormatIndex); // Sometimes date/time cells are stored as "float". // We convert them to date/time and also correct the date origin offset if // needed. - if IsDateTimeFormat(fmt^.NumberFormat) or IsDateTimeFormat(fmt^.NumberFormatStr) - then begin + if IsDateTimeFormat(numFmt) then + begin cell^.ContentType := cctDateTime; // No datemode correction for intervals and for time-only values - if (fmt^.NumberFormat = nfTimeInterval) or (cell^.NumberValue < 1) then + if (numFmt.NumFormat = nfTimeInterval) or (cell^.NumberValue < 1) then cell^.DateTimeValue := cell^.NumberValue else case FDateMode of @@ -1630,12 +1808,19 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode); stylename: String; styleindex: Integer; fmt: String; - posfmt, negfmt, zerofmt: String; + posfmt, negfmt, zerofmt, currfmt: String; nf: TsNumberFormat; + parser: TsNumFormatParser; + counter: Integer; begin posfmt := ''; negfmt := ''; zerofmt := ''; + currfmt := AFormatStr; + counter := 0; + + AFormatStr := ''; + ANumFormat := nfCustom; while ANode <> nil do begin @@ -1657,16 +1842,26 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode); Delete(condition, 1, Length('value()')); styleindex := -1; - styleindex := FNumFormatList.FindByName(stylename); + styleIndex := FindNumFormatByName(stylename); if (styleindex = -1) or (condition = '') then begin ANode := ANode.NextSibling; continue; end; - fmt := FNumFormatList[styleindex].FormatString; - nf := FNumFormatList[styleindex].NumFormat; - if nf in [nfCurrency, nfCurrencyRed] then ANumFormat := nf; + fmt := NumFormatList[styleIndex]; + fmt := Copy(fmt, pos(':', fmt)+1, Length(fmt)); + parser := TsNumFormatParser.Create(Workbook, fmt); + try + nf := parser.NumFormat; + if (nf = nfCurrency) and (parser.ParsedSections[0].Color = scRed) then + nf := nfCurrencyRed; + if nf in [nfCurrency, nfCurrencyRed] then + ANumFormat := nf; + finally + parser.Free; + end; + case condition[1] of '>': begin posfmt := fmt; @@ -1683,13 +1878,26 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode); end; end; ANode := ANode.NextSibling; + inc(counter); end; - if posfmt = '' then posfmt := AFormatStr; - if negfmt = '' then negfmt := AFormatStr; + { + if posfmt = '' then posfmt := currFmt; + if negfmt = '' then negfmt := currFmt; + } +// if posfmt = '' then posfmt := AFormatStr; +// if negfmt = '' then negfmt := AFormatStr; - AFormatStr := posFmt; - if negfmt <> '' then AFormatStr := AFormatStr + ';' + negfmt; - if zerofmt <> '' then AFormatStr := AFormatStr + ';' + zerofmt; + case counter of + 1: begin + if negfmt = '' then negfmt := currfmt; + AFormatStr := posfmt + ';' + negfmt; + end; + 2: begin + if zerofmt = '' then zerofmt := currfmt; + AFormatStr := posfmt + ';' + negfmt + ';' + zerofmt; + end; + 3: AFormatStr := posfmt + ';' + negfmt + ';' + zerofmt; + end; if not (ANumFormat in [nfCurrency, nfCurrencyRed]) then ANumFormat := nfCustom; @@ -1707,7 +1915,9 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode); grouping: Boolean; nex: Integer; cs: String; + color: TsColorValue; hasColor: Boolean; + idx: Integer; begin nfs := ''; cs := ''; @@ -1757,7 +1967,7 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode); while childnode <> nil do begin cs := cs + childNode.NodeValue; - nfs := nfs + childNode.NodeValue; + nfs := nfs + '"' + childNode.NodeValue + '"'; childNode := childNode.NextSibling; end; end else @@ -1776,14 +1986,14 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode); if s <> '' then begin hasColor := true; - { // currently not needed + // { // currently not needed color := HTMLColorStrToColor(s); idx := FWorkbook.AddColorToPalette(color); if idx < 8 then nfs := Format('[%s]%s', [FWorkbook.GetColorName(idx), nfs]) else nfs := Format('[Color%d]%s', [idx, nfs]); - } + // } end; end; node := node.NextSibling; @@ -1799,7 +2009,7 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode); if (ANumFormatNode.NodeName = 'number:currency-style') then nf := IfThen(hasColor, nfCurrencyRed, nfCurrency); - NumFormatList.AddFormat(ANumFormatName, nf, nfs); + NumFormatList.Add(Format('%s:%s', [ANumFormatName, nfs])); end; procedure ReadDateTimeStyle(ANumFormatNode: TDOMNode; ANumFormatName: String); @@ -1903,7 +2113,8 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode); if node <> nil then ReadStyleMap(node, nf, nfs); - NumFormatList.AddFormat(ANumFormatName, nf, nfs); + NumFormatList.Add(ANumFormatName + ':' + nfs); +// NumFormatList.AddFormat(ANumFormatName, nf, nfs); end; procedure ReadTextStyle(ANumFormatNode: TDOMNode; ANumFormatName: String); @@ -1941,7 +2152,9 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode); ReadStyleMap(node, nf, nfs); nf := nfCustom; - NumFormatList.AddFormat(ANumFormatName, nf, nfs); + NumFormatList.Add(Format('%s:%s', [ANumFormatName, nfs])); + + //NumFormatList.AddFormat(ANumFormatName, nf, nfs); end; var @@ -2294,8 +2507,9 @@ var fmt: TsCellFormat; numFmtIndexDefault: Integer; numFmtName: String; + numFmtStr: String; numFmtIndex: Integer; - numFmtData: TsNumFormatData; + numFmtParams: TsNumFormatParams; clr: TsColorValue; s: String; @@ -2375,7 +2589,7 @@ begin if not Assigned(AStylesNode) then exit; - numFmtIndexDefault := NumFormatList.FindByName('N0'); + numFmtIndexDefault := FindNumFormatByName('N0'); styleNode := AStylesNode.FirstChild; while Assigned(styleNode) do begin @@ -2406,13 +2620,17 @@ begin numFmtIndex := -1; numFmtName := GetAttrValue(styleNode, 'style:data-style-name'); - if numFmtName <> '' then numFmtIndex := NumFormatList.FindByName(numFmtName); + if numFmtName <> '' then numFmtIndex := FindNumFormatByName(numFmtName); if numFmtIndex = -1 then numFmtIndex := numFmtIndexDefault; - numFmtData := NumFormatList.Items[numFmtIndex]; - fmt.NumberFormat := numFmtData.NumFormat; - fmt.NumberFormatStr := numFmtData.FormatString; - if fmt.NumberFormat <> nfGeneral then + numFmtStr := NumFormatList[numFmtIndex]; + numFmtStr := Copy(numFmtStr, pos(':', numFmtStr)+1, Length(numFmtStr)); + fmt.NumberFormatIndex := Workbook.AddNumberFormat(numFmtStr); + numFmtParams := Workbook.GetNumberFormat(fmt.NumberFormatIndex); + if numFmtParams <> nil then begin + fmt.NumberFormat := numFmtParams.NumFormat; + fmt.NumberFormatStr := numFmtStr; Include(fmt.UsedFormattingFields, uffNumberFormat); + end; styleChildNode := styleNode.FirstChild; while Assigned(styleChildNode) do @@ -2559,10 +2777,10 @@ end; { TsSpreadOpenDocWriter } -procedure TsSpreadOpenDocWriter.CreateNumFormatList; +procedure TsSpreadOpenDocWriter.AddBuiltinNumFormats; begin - FreeAndNil(FNumFormatList); - FNumFormatList := TsSpreadOpenDocNumFormatList.Create(Workbook); + FNumFormatList.Clear; + FNumFormatList.Add('N0:'); end; { Creates the streams for the individual data files. Will be zipped into a @@ -2669,9 +2887,20 @@ end; { Contains all number formats used in the workbook. Overrides the inherited method to assign a unique name according to the OpenDocument syntax ("N" to the format items. } -procedure TsSpreadOpenDocWriter.ListAllNumFormats; +procedure TsSpreadOpenDocWriter.ListAllNumFormats(ADialect: TsNumFormatDialect); const FMT_BASE = 1000; // Format number to start with. Not clear if this is correct... +var + i: Integer; + nfparams: TsNumFormatParams; +begin + // The default format has already been added. + for i:=0 to Workbook.GetNumberFormatCount - 1 do + begin + nfParams := Workbook.GetNumberFormat(i); + FNumFormatList.Add(Format('N%d:%s', [FMT_BASE+i, nfParams.NumFormatStr[ADialect]])); + end; + { var n, i, j: Integer; begin @@ -2683,6 +2912,7 @@ begin NumFormatList.Items[i].Name := Format('N%d', [FMT_BASE + j]); inc(j); end; + } end; procedure TsSpreadOpenDocWriter.ListAllRowStyles; @@ -2995,20 +3225,39 @@ end; procedure TsSpreadOpenDocWriter.WriteCellStyles(AStream: TStream); var - i: Integer; + i, j, p: Integer; s: String; nfidx: Integer; nfs: String; fmt: TsCellFormat; + nfParams: TsNumFormatParams; begin for i := 0 to FWorkbook.GetNumCellFormats - 1 do begin fmt := FWorkbook.GetCellFormat(i); - - nfidx := NumFormatList.FindByFormatStr(fmt.NumberFormatStr); - if nfidx <> -1 - then nfs := 'style:data-style-name="' + NumFormatList[nfidx].Name +'"' - else nfs := ''; + nfs := ''; + nfidx := fmt.NumberFormatIndex; + if nfidx <> -1 then + begin + nfParams := FWorkbook.GetNumberFormat(nfidx); + if nfParams <> nil then + begin + nfs := nfParams.NumFormatStr[nfdExcel]; + for j:=0 to NumFormatList.Count-1 do + begin + s := NumFormatList[j]; + p := pos(':', s); + if SameText(Copy(s, p+1, Length(s)), nfs) then + begin + nfs := Format('style:data-style-name="%s"', [copy(s, 1, p-1)]); + break; + end; + p := 0; + end; + if p = 0 then // not found + nfs := ''; + end; + end; // Start and name AppendToStream(AStream, @@ -3016,12 +3265,6 @@ begin 'style:parent-style-name="Default" '+ nfs + '>'); // style:text-properties - { - if (uffBold in fmt.UsedFormattingFields) then - AppendToStream(AStream, - ''); - } - s := WriteFontStyleXMLAsString(fmt); if s <> '' then AppendToStream(AStream, @@ -3194,13 +3437,27 @@ end; procedure TsSpreadOpenDocWriter.WriteNumFormats(AStream: TStream); var - i: Integer; + i, p: Integer; numFmtXML: String; - fmtItem: TsNumFormatData; + numFmtStr: String; + numFmtName: String; parser: TsSpreadOpenDocNumFormatParser; begin - for i:=0 to FNumFormatList.Count-1 do + for i:=0 to NumFormatList.Count-1 do begin + numFmtStr := NumFormatList[i]; + p := pos(':', numFmtStr); + numFmtName := Copy(numFmtStr, 1, p-1); + numFmtStr := Copy(numFmtStr, p+1, Length(numFmtStr)); + parser := TsSpreadOpenDocNumFormatParser.Create(Workbook, numFmtStr); + try + numFmtXML := parser.BuildXMLAsString(numFmtName); + if numFmtXML <> '' then + AppendToStream(AStream, numFmtXML); + finally + parser.Free; + end; + { fmtItem := FNumFormatList.Items[i]; parser := TsSpreadOpenDocNumFormatParser.Create(Workbook, fmtItem.FormatString, fmtItem.NumFormat); @@ -3211,6 +3468,7 @@ begin finally parser.Free; end; + } end; end; @@ -3475,8 +3733,7 @@ var FZip: TZipper; begin { Analyze the workbook and collect all information needed } - ListAllNumFormats; -// ListAllFormattingStyles; + ListAllNumFormats(nfdExcel); ListAllColumnStyles; ListAllRowStyles; @@ -4299,6 +4556,8 @@ var comment: String; r1,c1,r2,c2: Cardinal; fmt: TsCellFormat; + numFmt: TsNumFormatParams; + nfSection: TsNumFormatSection; begin Unused(ARow, ACol); @@ -4306,11 +4565,22 @@ begin fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex); if fmt.UsedFormattingFields <> [] then begin + numFmt := FWorkbook.GetNumberFormat(fmt.NumberFormatIndex); + if (numFmt <> nil) then begin + if (Length(numFmt.Sections) > 1) and (AValue < 0) then + nfSection := numFmt.Sections[1] + else + if (Length(numFmt.Sections) > 2) and (AValue = 0) then + nfSection := NumFmt.Sections[2] + else + nfSection := numFmt.Sections[0]; + if (nfkPercent in nfSection.Kind) then + valType := 'percentage' + else + if (nfkCurrency in nfSection.Kind) then + valtype := 'currency' + end; lStyle := ' table:style-name="ce' + IntToStr(ACell^.FormatIndex) + '" '; - if pos('%', fmt.NumberFormatStr) <> 0 then - valType := 'percentage' - else if IsCurrencyFormat(fmt.NumberFormat) then - valType := 'currency'; end else lStyle := ''; @@ -4334,7 +4604,7 @@ begin DisplayStr := '1.#INF'; end else begin StrValue := FloatToStr(AValue, FPointSeparatorSettings); // Uses '.' as decimal separator - DisplayStr := FloatToStr(AValue); // Uses locale decimal separator + DisplayStr := FWorksheet.ReadAsUTF8Text(ACell); //FloatToStr(AValue); // Uses locale decimal separator end; // Hyperlink @@ -4371,6 +4641,7 @@ var comment: String; r1,c1,r2,c2: Cardinal; fmt: TsCellFormat; + numFmtParams: TsNumFormatParams; begin Unused(ARow, ACol); @@ -4385,6 +4656,7 @@ begin spannedStr := ''; fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex); + numFmtParams := FWorkbook.GetNumberFormat(fmt.NumberFormatIndex); if fmt.UsedFormattingFields <> [] then lStyle := ' table:style-name="ce' + IntToStr(ACell^.FormatIndex) + '" ' else @@ -4399,10 +4671,11 @@ begin // nfTimeInterval is a special case - let's handle it first: - if (fmt.NumberFormat = nfTimeInterval) then + if IsTimeIntervalformat(numFmtParams) then begin strValue := FormatDateTime(ISO8601FormatHoursOverflow, AValue, [fdoInterval]); - displayStr := FormatDateTime(fmt.NumberFormatStr, AValue, [fdoInterval]); + displayStr := FWorksheet.ReadAsUTF8Text(ACell); +// displayStr := FormatDateTime(fmt.NumberFormatStr, AValue, [fdoInterval]); AppendToStream(AStream, Format( '' + comment + @@ -4414,9 +4687,12 @@ begin end else begin // We have to distinguish between time-only values and values that contain date parts. - isTimeOnly := IsTimeFormat(fmt.NumberFormat) or IsTimeFormat(fmt.NumberFormatStr); + if (numFmtParams <> nil) then + isTimeOnly := Assigned(numFmtParams) and (numFmtParams.Sections[0].Kind * [nfkDate, nfkTime] = [nfkTime]) + else + isTimeOnly := false; strValue := FormatDateTime(DATE_FMT[isTimeOnly], AValue); - displayStr := FormatDateTime(fmt.NumberFormatStr, AValue); + displayStr := FWorksheet.ReadAsUTF8Text(ACell); AppendToStream(AStream, Format( '' + comment + diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 6d5c40d29..3ba90184c 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -98,9 +98,6 @@ type FLeftPaneWidth: Integer; FTopPaneHeight: Integer; FOptions: TsSheetOptions; -// FLastFoundCell: PCell; -// FLastFoundRow: Cardinal; -// FLastFoundCol: Cardinal; FFirstRowIndex: Cardinal; FFirstColIndex: Cardinal; FLastRowIndex: Cardinal; @@ -204,10 +201,12 @@ type procedure WriteCurrency(ACell: PCell; AValue: Double; ANumFormat: TsNumberFormat; ANumFormatString: String); overload; + function WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime): PCell; overload; + procedure WriteDateTime(ACell: PCell; AValue: TDateTime); overload; function WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime; - ANumFormat: TsNumberFormat = nfShortDateTime; ANumFormatStr: String = ''): PCell; overload; + ANumFormat: TsNumberFormat; ANumFormatStr: String = ''): PCell; overload; procedure WriteDateTime(ACell: PCell; AValue: TDateTime; - ANumFormat: TsNumberFormat = nfShortDateTime; ANumFormatStr: String = ''); overload; + ANumFormat: TsNumberFormat; ANumFormatStr: String = ''); overload; function WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime; ANumFormatStr: String): PCell; overload; procedure WriteDateTime(ACell: PCell; AValue: TDateTime; @@ -358,11 +357,8 @@ type function FindCell(AddressStr: String): PCell; overload; function GetCell(ARow, ACol: Cardinal): PCell; overload; function GetCell(AddressStr: String): PCell; overload; - function GetCellCount: Cardinal; -// function GetFirstCellOfRow(ARow: Cardinal): PCell; -// function GetLastCellOfRow(ARow: Cardinal): PCell; function GetFirstColIndex(AForceCalculation: Boolean = false): Cardinal; function GetLastColIndex(AForceCalculation: Boolean = false): Cardinal; function GetLastColNumber: Cardinal; deprecated 'Use GetLastColIndex'; @@ -439,7 +435,7 @@ type procedure UnmergeCells(ARow, ACol: Cardinal); overload; procedure UnmergeCells(ARange: String); overload; - // Notification of changed cells content and format + // Notification of changed cells procedure ChangedCell(ARow, ACol: Cardinal); procedure ChangedFont(ARow, ACol: Cardinal); @@ -580,8 +576,9 @@ type procedure RemoveWorksheetsCallback(data, arg: pointer); protected - FCellFormatList: TsCellFormatList; FFontList: TFPList; + FNumFormatList: TFPList; + FCellFormatList: TsCellFormatList; { Internal methods } procedure GetLastRowColIndex(out ALastRow, ALastCol: Cardinal); @@ -664,6 +661,11 @@ type ASize: Single; AStyle: TsFontStyles; AColor: TsColor); procedure SetDefaultFont(const AFontName: String; ASize: Single); + { Number format handling } + function AddNumberFormat(AFormatStr: String): Integer; + function GetNumberFormat(AIndex: Integer): TsNumFormatParams; + function GetNumberFormatCount: Integer; + { Color handling } function AddColorToPalette(AColorValue: TsColorValue): TsColor; function FindClosestColor(AColorValue: TsColorValue; @@ -690,12 +692,6 @@ type {@@ Identifies the "active" worksheet (only for visual controls)} property ActiveWorksheet: TsWorksheet read FActiveWorksheet; - (* - {@@ This property is only used for formats which don't support unicode - and support a single encoding for the whole document, like Excel 2 to 5 } - property CodePage: String read FCodePage write FCodepage; - *) -// property Encoding: TsEncoding read FEncoding write FEncoding; {@@ Retrieves error messages collected during reading/writing } property ErrorMsg: String read GetErrorMsg; {@@ Filename of the saved workbook } @@ -1112,10 +1108,6 @@ begin FActiveCellRow := Cardinal(-1); FActiveCellCol := Cardinal(-1); -{ FLastFoundCell := nil; - FLastFoundRow := Cardinal(-1); - FLastFoundCol := Cardinal(-1);} - FOptions := [soShowGridLines, soShowHeaders]; end; @@ -2090,17 +2082,6 @@ end; function TsWorksheet.FindCell(ARow, ACol: Cardinal): PCell; begin Result := PCell(FCells.FindByRowCol(ARow, ACol)); -{ - if (ARow = FLastFoundRow) and (ACol = FLastFoundCol) then - Result := FLastFoundCell - else - begin - Result := PCell(FCells.Find(ARow, ACol)); - FLastFoundCell := Result; - FLastFoundRow := ARow; - FLastFoundCol := ACol; - end; -} end; {@@ ---------------------------------------------------------------------------- @@ -2319,7 +2300,7 @@ begin // Traverse the tree from lowest to highest. // Since tree primary sort order is on row highest col could exist anywhere. Result := GetLastOccupiedColIndex; - // In addition, there may be column records defining the column width even + // In addition, there may be column records defining the column width even // without cells for i:=0 to FCols.Count-1 do if FCols[i] <> nil then @@ -2361,29 +2342,7 @@ begin for cell in FCells do Result := Math.Max(Result, cell^.Col); end; - (* -{@@ ---------------------------------------------------------------------------- - Finds the first cell with contents in a given row - @param ARow Index of the row considered - @return Pointer to the first cell in this row, or nil if the row is empty. --------------------------------------------------------------------------------} -function TsWorksheet.GetFirstCellOfRow(ARow: Cardinal): PCell; -begin - Result := FCells.GetFirstCellOfRow(ARow); -end; - -{@@ ---------------------------------------------------------------------------- - Finds the last cell with data or formatting in a given row - - @param ARow Index of the row considered - @return Pointer to the last cell in this row, or nil if the row is empty. --------------------------------------------------------------------------------} -function TsWorksheet.GetLastCellOfRow(ARow: Cardinal): PCell; -begin - Result := FCells.GetLastCellOfRow(ARow); -end; - *) {@@ ---------------------------------------------------------------------------- Returns the 0-based index of the first row with a cell with data or formatting. If no cells have contents, -1 will be returned. @@ -2513,70 +2472,25 @@ begin Result := ReadAsUTF8Text(ACell, FWorkbook.FormatSettings); end; +{@@ ---------------------------------------------------------------------------- + Reads the contents of a cell and returns an user readable text + representing the contents of the cell. + + The resulting string is UTF-8 encoded. + + @param ACell Pointer to the cell + @param AFormatSettings Format settings to be used for string conversion + of numbers and date/times. + @return The text representation of the cell +-------------------------------------------------------------------------------} function TsWorksheet.ReadAsUTF8Text(ACell: PCell; - AFormatSettings: TFormatSettings): string; //ansistring; - - function FloatToStrNoNaN(const AValue: Double; - ANumberFormat: TsNumberFormat; ANumberFormatStr: string): string; //ansistring; - var - i: Integer; - begin - if IsNan(AValue) then - Result := '' - else - if (ANumberFormat = nfGeneral) or (ANumberFormatStr = '') then - Result := FloatToStr(AValue, AFormatSettings) - else - if (ANumberFormat = nfPercentage) then - Result := FormatFloat(ANumberFormatStr, AValue*100, AFormatSettings) - else - if (ANumberFormat = nfFraction) then - Result := FormatAsFraction(ANumberFormatStr, AValue) - else - if IsCurrencyFormat(ANumberFormat) then - Result := FormatCurr(ANumberFormatStr, AValue, AFormatSettings) - else - Result := FormatFloat(ANumberFormatStr, AValue, AFormatSettings) - end; - - function DateTimeToStrNoNaN(const Value: Double; - ANumberFormat: TsNumberFormat; ANumberFormatStr: String): string; //ansistring; - var - fmtp, fmtn, fmt0: String; - begin - Result := ''; - if not IsNaN(Value) then - begin - if (ANumberFormat = nfGeneral) then - begin - if frac(Value) = 0 then // date only - ANumberFormatStr := AFormatSettings.ShortDateFormat - else if trunc(Value) = 0 then // time only - ANumberFormatStr := AFormatSettings.LongTimeFormat - else - ANumberFormatStr := 'cc' - end else - if ANumberFormatStr = '' then - ANumberFormatStr := BuildDateTimeFormatString(ANumberFormat, - AFormatSettings, ANumberFormatStr); - - // Saw strange cases in ods where date/time formats contained pos/neg/zero parts. - // Split to be on the safe side. - SplitFormatString(ANumberFormatStr, fmtp, fmtn, fmt0); - if (Value > 0) or ((Value = 0) and (fmt0 = '')) or ((Value < 0) and (fmtn = '')) then - Result := FormatDateTime(fmtp, Value, [fdoInterval]) - else - if (Value < 0) then - Result := FormatDateTime(fmtn, Value, [fdoInterval]) - else - if (Value = 0) then - Result := FormatDateTime(fmt0, Value, [fdoInterval]); - end; - end; - + AFormatSettings: TFormatSettings): string; var fmt: PsCellFormat; hyperlink: PsHyperlink; + numFmt: TsNumFormatParams; + nf: TsNumberFormat; + nfs: String; begin Result := ''; @@ -2584,16 +2498,36 @@ begin Exit; fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); + numFmt := Workbook.GetNumberFormat(fmt^.NumberFormatIndex); + with ACell^ do case ContentType of - cctNumber: - Result := FloatToStrNoNaN(NumberValue, fmt^.NumberFormat, fmt^.NumberFormatStr); cctUTF8String: Result := UTF8StringValue; + + cctNumber: + Result := ConvertFloatToStr(NumberValue, numFmt, AFormatSettings); + cctDateTime: - Result := DateTimeToStrNoNaN(DateTimeValue, fmt^.NumberFormat, fmt^.NumberFormatStr); + if Assigned(numFmt) then + Result := ConvertFloatToStr(DateTimeValue, numFmt, AFormatSettings) + else + if not IsNaN(DateTimeValue) then + begin + if frac(DateTimeValue) = 0 then // date only + nf := nfShortDate + else + if trunc(DateTimeValue) = 0 then // time only + nf := nfLongTime + else + nf := nfShortDateTime; + nfs := BuildDateTimeFormatString(nf, AFormatSettings); + Result := FormatDateTime(nfs, DateTimeValue, AFormatSettings); + end; + cctBool: Result := StrUtils.IfThen(BoolValue, rsTRUE, rsFALSE); + cctError: case TsErrorValue(ErrorValue) of errEmptyIntersection : Result := rsErrEmptyIntersection; @@ -2605,7 +2539,8 @@ begin errArgError : Result := rsErrArgError; errFormulaNotSupported: Result := rsErrFormulaNotSupported; end; - else + + else // blank --> display hyperlink target if available Result := ''; if HasHyperlink(ACell) then begin @@ -2773,20 +2708,6 @@ begin end else Result := False; end; - (* -{@@ ---------------------------------------------------------------------------- - Returns the comment assigned to a cell - - @param ACell Pointer to the cell considered - @return String attached to the cell as a comment --------------------------------------------------------------------------------} -function TsWorksheet.ReadComment(ACell: PCell): String; -begin - if ACell <> nil then - Result := ACell^.Comment - else - Result := ''; -end; *) {@@ ---------------------------------------------------------------------------- Converts an RPN formula (as read from an xls biff file, for example) to a @@ -2992,11 +2913,6 @@ begin if ACell <> nil then begin fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); - { - if (uffBold in fmt^.UsedFormattingFields) then - Result := Workbook.GetFont(BOLD_FONTINDEX) - else - } Result := Workbook.GetFont(fmt^.FontIndex); end; if Result = nil then @@ -3034,6 +2950,7 @@ procedure TsWorksheet.ReadNumFormat(ACell: PCell; out ANumFormat: TsNumberFormat out ANumFormatStr: String); var fmt: PsCellFormat; + numFmt: TsNumFormatParams; begin ANumFormat := nfGeneral; ANumFormatStr := ''; @@ -3042,8 +2959,16 @@ begin fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); if (uffNumberFormat in fmt^.UsedFormattingFields) then begin - ANumFormat := fmt^.NumberFormat; - ANumFormatStr := fmt^.NumberFormatStr; + numFmt := Workbook.GetNumberFormat(fmt.NumberFormatIndex); + if numFmt <> nil then + begin + ANumFormat := numFmt.NumFormat; + ANumFormatStr := numFmt.NumFormatStr[nfdDefault]; + end else + begin + ANumFormat := nfGeneral; + ANumFormatStr := ''; + end; end; end; end; @@ -3294,7 +3219,6 @@ begin Result := (ACell <> nil) and (cfMerged in ACell^.Flags); end; - {@@ ---------------------------------------------------------------------------- Removes the comment from a cell and releases the memory occupied by the node. -------------------------------------------------------------------------------} @@ -3595,22 +3519,12 @@ procedure TsWorksheet.Sort(const ASortParams: TsSortParams; function ContainsMergedCells: boolean; var - //r,c: Cardinal; cell: PCell; begin result := false; for cell in Cells.GetRangeEnumerator(ARowFrom, AColFrom, ARowTo, AColTo) do if IsMerged(cell) then exit(true); - { - for r := ARowFrom to ARowTo do - for c := AColFrom to AColTo do - begin - cell := FindCell(r, c); - if IsMerged(cell) then - exit(true); - end; - } end; begin @@ -3781,11 +3695,11 @@ begin end; {@@ ---------------------------------------------------------------------------- - Writes a floating-point number to a cell. Does not change number format. + Writes a floating-point number to a cell, does not change the number format - @param ARow Cell row index - @param ACol Cell column index - @param ANumber Number to be written + @param ARow Cell row index + @param ACol Cell column index + @param ANumber Number to be written @return Pointer to cell created or used -------------------------------------------------------------------------------} function TsWorksheet.WriteNumber(ARow, ACol: Cardinal; ANumber: double): PCell; @@ -3795,13 +3709,12 @@ begin end; {@@ ---------------------------------------------------------------------------- - Writes a floating-point number to a cell. Does not change number format. + Writes a floating-point number to a cell, does not change the number format - @param ARow Cell row index - @param ACol Cell column index - @param ANumber Number to be written + @param ACell Pointer to the cell + @param ANumber Number to be written -------------------------------------------------------------------------------} -procedure TsWorksheet.WriteNumber(ACell: PCell; ANumber: double); +procedure TsWorksheet.WriteNumber(ACell: PCell; ANumber: Double); begin if ACell <> nil then begin ACell^.ContentType := cctNumber; @@ -3822,7 +3735,7 @@ end; @see TsNumberFormat -------------------------------------------------------------------------------} function TsWorksheet.WriteNumber(ARow, ACol: Cardinal; ANumber: double; - ANumFormat: TsNumberFormat; ADecimals: Byte = 2): PCell; + ANumFormat: TsNumberFormat = nfGeneral; ADecimals: Byte = 2): PCell; begin Result := GetCell(ARow, ACol); WriteNumber(Result, ANumber, ANumFormat, ADecimals); @@ -3835,12 +3748,15 @@ end; @param ANumber Number to be written @param ANumFormat Identifier for a built-in number format, e.g. nfFixed @param ADecimals Optional number of decimal places used for formatting + If ANumFormat is nfFraction the ADecimals defines the + digits of Numerator and denominator. @see TsNumberFormat -------------------------------------------------------------------------------} procedure TsWorksheet.WriteNumber(ACell: PCell; ANumber: Double; ANumFormat: TsNumberFormat; ADecimals: Byte = 2); var fmt: TsCellFormat; + nfs: String; begin if IsDateTimeFormat(ANumFormat) or IsCurrencyFormat(ANumFormat) then raise Exception.Create(rsInvalidNumberFormat); @@ -3853,11 +3769,16 @@ begin fmt.NumberFormat := ANumFormat; if ANumFormat <> nfGeneral then begin Include(fmt.UsedFormattingFields, uffNumberFormat); - fmt.NumberFormatStr := BuildNumberFormatString(fmt.NumberFormat, - Workbook.FormatSettings, ADecimals); + if ANumFormat = nfFraction then + begin + if ADecimals = 0 then ADecimals := 1; + nfs := '# ' + DupeString('?', ADecimals) + '/' + DupeString('?', ADecimals); + end else + nfs := BuildNumberFormatString(fmt.NumberFormat, Workbook.FormatSettings, ADecimals); + fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs); end else begin Exclude(fmt.UsedFormattingFields, uffNumberFormat); - fmt.NumberFormatStr := ''; + fmt.NumberFormatIndex := -1; end; ACell^.FormatIndex := Workbook.AddCellFormat(fmt); @@ -3921,13 +3842,12 @@ begin ACell^.NumberValue := ANumber; fmt := Workbook.GetCellFormat(ACell^.FormatIndex); - fmt.NumberFormat := ANumFormat; if ANumFormat <> nfGeneral then begin + fmt.NumberFormatIndex := Workbook.AddNumberFormat(ANumFormatString); Include(fmt.UsedFormattingFields, uffNumberFormat); - fmt.NumberFormatStr := ANumFormatString; end else begin Exclude(fmt.UsedFormattingFields, uffNumberFormat); - fmt.NumberFormatStr := ''; + fmt.NumberFormatIndex := -1; end; ACell^.FormatIndex := Workbook.AddCellFormat(fmt); @@ -4222,20 +4142,51 @@ procedure TsWorksheet.WriteCurrency(ACell: PCell; AValue: Double; var fmt: TsCellFormat; begin + if not (ANumFormat in [nfCurrency, nfCurrencyRed]) then + raise Exception.Create('[TsWorksheet.WriteCurrency] ANumFormat can only be nfCurrency or nfCurrencyRed'); + if (ACell <> nil) and IsCurrencyFormat(ANumFormat) then begin ACell^.ContentType := cctNumber; ACell^.NumberValue := AValue; fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex); + fmt.NumberFormatIndex := Workbook.AddNumberFormat(ANumFormatString); Include(fmt.UsedFormattingFields, uffNumberFormat); - fmt.NumberFormat := ANumFormat; - fmt.NumberFormatStr := ANumFormatString; ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt); ChangedCell(ACell^.Row, ACell^.Col); end; end; +{@@ ---------------------------------------------------------------------------- + Writes a date/time value to a cell, does not change number format + + @param ARow The row of the cell + @param ACol The column of the cell + @param AValue The date/time/datetime to be written + @return Pointer to the cell +-------------------------------------------------------------------------------} +function TsWorksheet.WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime): PCell; +begin + Result := GetCell(ARow, ACol); + WriteDateTime(Result, AValue); +end; + +{@@ ---------------------------------------------------------------------------- + Writes a date/time value to a cell. Does not change number format + + @param ACell Pointer to the cell considered + @param AValue The date/time/datetime to be written +-------------------------------------------------------------------------------} +procedure TsWorksheet.WriteDateTime(ACell: PCell; AValue: TDateTime); +begin + if ACell <> nil then begin + ACell^.ContentType := cctDateTime; + ACell^.DateTimeValue := AValue; + ChangedCell(ACell^.Row, ACell^.Col); + end; +end; + {@@ ---------------------------------------------------------------------------- Writes a date/time value to a cell @@ -4252,7 +4203,7 @@ end; as a date (either built-in or a custom format). -------------------------------------------------------------------------------} function TsWorksheet.WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime; - ANumFormat: TsNumberFormat = nfShortDateTime; ANumFormatStr: String = ''): PCell; + ANumFormat: TsNumberFormat; ANumFormatStr: String = ''): PCell; begin Result := GetCell(ARow, ACol); WriteDateTime(Result, AValue, ANumFormat, ANumFormatStr); @@ -4272,7 +4223,7 @@ end; as a date (either built-in or a custom format). -------------------------------------------------------------------------------} procedure TsWorksheet.WriteDateTime(ACell: PCell; AValue: TDateTime; - ANumFormat: TsNumberFormat = nfShortDateTime; ANumFormatStr: String = ''); + ANumFormat: TsNumberFormat; ANumFormatStr: String = ''); var parser: TsNumFormatParser; fmt: TsCellFormat; @@ -4320,6 +4271,7 @@ begin Include(fmt.UsedFormattingFields, uffNumberFormat); fmt.NumberFormat := ANumFormat; fmt.NumberFormatStr := ANumFormatStr; + fmt.NumberFormatIndex := Workbook.AddNumberFormat(fmt.NumberFormatStr); ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt); ChangedCell(ACell^.Row, ACell^.Col); @@ -4452,27 +4404,25 @@ procedure TsWorksheet.WriteDecimals(ACell: PCell; ADecimals: Byte); var parser: TsNumFormatParser; fmt: TsCellFormat; + numFmt: TsNumFormatParams; + numFmtStr: String; begin if (ACell = nil) then exit; fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex); - if (uffNumberFormat in fmt.UsedFormattingFields) or (fmt.NumberFormat = nfGeneral) - then - WriteNumberFormat(ACell, nfFixed, ADecimals) - else - if fmt.NumberFormat <> nfCustom then - begin - parser := TsNumFormatParser.Create(Workbook, fmt.NumberFormatStr); - try - parser.Decimals := ADecimals; - fmt.NumberFormatStr := parser.FormatString[nfdDefault]; - finally - parser.Free; - end; + numFmt := FWorkbook.GetNumberFormat(fmt.NumberFormatIndex); + numFmtStr := numFmt.NumFormatStr[nfdDefault]; + parser := TsNumFormatParser.Create(Workbook, numFmtStr); + try + parser.Decimals := ADecimals; + numFmtStr := parser.FormatString[nfdDefault]; + fmt.NumberFormatIndex := Workbook.AddNumberFormat(numFmtStr); Include(fmt.UsedFormattingFields, uffNumberFormat); ACell^.FormatIndex := Workbook.AddCellFormat(fmt); ChangedCell(ACell^.Row, ACell^.Col); + finally + parser.Free; end; end; @@ -4606,6 +4556,7 @@ procedure TsWorksheet.WriteNumberFormat(ACell: PCell; APosCurrFormat: Integer = -1; ANegCurrFormat: Integer = -1); var fmt: TsCellFormat; + fmtStr: String; begin if ACell = nil then exit; @@ -4616,16 +4567,17 @@ begin Include(fmt.UsedFormattingFields, uffNumberFormat); if ANumFormat in [nfCurrency, nfCurrencyRed] then begin - fmt.NumberFormatStr := BuildCurrencyFormatString(nfdDefault, ANumFormat, + RegisterCurrency(ACurrencySymbol); + fmtStr := BuildCurrencyFormatString(nfdDefault, ANumFormat, Workbook.FormatSettings, ADecimals, APosCurrFormat, ANegCurrFormat, ACurrencySymbol); - RegisterCurrency(ACurrencySymbol); end else - fmt.NumberFormatStr := BuildNumberFormatString(ANumFormat, + fmtStr := BuildNumberFormatString(ANumFormat, Workbook.FormatSettings, ADecimals); + fmt.NumberFormatIndex := Workbook.AddNumberFormat(fmtStr); end else begin Exclude(fmt.UsedFormattingFields, uffNumberFormat); - fmt.NumberFormatStr := ''; + fmt.NumberFormatIndex := -1; end; ACell^.FormatIndex := Workbook.AddCellFormat(fmt); @@ -4667,14 +4619,14 @@ procedure TsWorksheet.WriteFractionFormat(ACell: PCell; AMixedFraction: Boolean; ANumeratorDigits, ADenominatorDigits: Integer); var fmt: TsCellFormat; + nfs: String; begin if ACell = nil then exit; fmt := Workbook.GetCellFormat(ACell^.FormatIndex); - fmt.NumberFormat := nfFraction; - fmt.NumberFormatStr := BuildFractionFormatString(AMixedFraction, - ANumeratorDigits, ADenominatorDigits); + nfs := BuildFractionFormatString(AMixedFraction, ANumeratorDigits, ADenominatorDigits); + fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs); Include(fmt.UsedFormattingFields, uffNumberFormat); ACell^.FormatIndex := Workbook.AddCellFormat(fmt); @@ -4714,21 +4666,22 @@ procedure TsWorksheet.WriteNumberFormat(ACell: PCell; ANumFormat: TsNumberFormat; const ANumFormatString: String = ''); var fmt: TsCellFormat; + fmtStr: String; begin if ACell = nil then exit; fmt := Workbook.GetCellFormat(ACell^.FormatIndex); - fmt.NumberFormat := ANumFormat; if ANumFormat <> nfGeneral then begin Include(fmt.UsedFormattingFields, uffNumberFormat); if (ANumFormatString = '') then - fmt.NumberFormatStr := BuildNumberFormatString(ANumFormat, Workbook.FormatSettings) + fmtStr := BuildNumberFormatString(ANumFormat, Workbook.FormatSettings) else - fmt.NumberFormatStr := ANumFormatString; + fmtStr := ANumFormatString; + fmt.NumberFormatIndex := Workbook.AddNumberFormat(fmtStr); end else begin Exclude(fmt.UsedFormattingFields, uffNumberFormat); - fmt.NumberFormatStr := ''; + fmt.NumberFormatIndex := -1; end; ACell^.FormatIndex := Workbook.AddCellFormat(fmt); @@ -5112,7 +5065,6 @@ begin ChangedCell(ACell^.Row, ACell^.Col); end; - {@@ ---------------------------------------------------------------------------- Defines a background pattern for a cell @@ -6334,6 +6286,7 @@ begin SetDefaultFont(DEFAULT_FONTNAME, DEFAULT_FONTSIZE); InitFonts; + FNumFormatList := TsNumFormatList.Create(self, true); FCellFormatList := TsCellFormatList.Create(false); // Add default cell format @@ -6351,6 +6304,7 @@ begin FWorksheets.Free; FCellFormatList.Free; + FNumFormatList.Free; FFontList.Free; FLog.Free; @@ -6700,6 +6654,7 @@ begin AWriter := CreateSpreadWriter(AFormat); try FFileName := AFileName; + FFormat := AFormat; PrepareBeforeSaving; AWriter.CheckLimitations; FReadWriteFlag := rwfWrite; @@ -7202,16 +7157,13 @@ var fmt: PsCellFormat; cb: TsCellBorder; s: String; + numFmt: TsNumFormatParams; begin Result := ''; fmt := GetPointerToCellFormat(AIndex); if fmt = nil then exit; - { - if (uffBold in fmt^.UsedFormattingFields) then - Result := Format('%s; bold', [Result]); - } if (uffFont in fmt^.UsedFormattingFields) then Result := Format('%s; Font%d', [Result, fmt^.FontIndex]); if (uffBackground in fmt^.UsedFormattingFields) then begin @@ -7226,10 +7178,17 @@ begin if (uffWordwrap in fmt^.UsedFormattingFields) then Result := Format('%s; Word-wrap', [Result]); if (uffNumberFormat in fmt^.UsedFormattingFields) then - Result := Format('%s; %s (%s)', [Result, - GetEnumName(TypeInfo(TsNumberFormat), ord(fmt^.NumberFormat)), - fmt^.NumberFormatStr - ]); + begin + numFmt := GetNumberFormat(fmt^.NumberFormatIndex); + if numFmt <> nil then + Result := Format('%s; %s (%s)', [Result, + GetEnumName(TypeInfo(TsNumberFormat), ord(numFmt.NumFormat)), + numFmt.NumFormatStr[nfdDefault] + ]) + else + Result := Format('%s; %s', [Result, 'nfGeneral']); + end else + Result := Format('%s; %s', [Result, 'nfGeneral']); if (uffBorder in fmt^.UsedFormattingFields) then begin s := ''; @@ -7505,6 +7464,39 @@ begin end; +{@@ ---------------------------------------------------------------------------- + Adds a number format to the internal list. Returns the list index if already + present, or creates a new format item and returns its index. +-------------------------------------------------------------------------------} +function TsWorkbook.AddNumberFormat(AFormatStr: String): Integer; +begin + if AFormatStr = '' then + Result := -1 // General number format is not stored + else + Result := TsNumFormatList(FNumFormatList).AddFormat(AFormatStr, nfdDefault); +end; + +{@@ ---------------------------------------------------------------------------- + Returns the parameters of the number format stored in the NumFormatList at the + specified index. + "General" number format is returned as nil. +-------------------------------------------------------------------------------} +function TsWorkbook.GetNumberFormat(AIndex: Integer): TsNumFormatParams; +begin + if (AIndex >= 0) and (AIndex < FNumFormatList.Count) then + Result := TsNumFormatParams(FNumFormatList.Items[AIndex]) + else + Result := nil; +end; + +{@@ ---------------------------------------------------------------------------- + Returns the count of number format records stored in the NumFormatList +-------------------------------------------------------------------------------} +function TsWorkbook.GetNumberFormatCount: Integer; +begin + Result := FNumFormatList.Count; +end; + {@@ ---------------------------------------------------------------------------- Adds a color to the palette and returns its palette index, but only if the color does not already exist - in this case, it returns the index of the diff --git a/components/fpspreadsheet/fpspreadsheetctrls.pas b/components/fpspreadsheet/fpspreadsheetctrls.pas index 0b964ce78..b6292760f 100644 --- a/components/fpspreadsheet/fpspreadsheetctrls.pas +++ b/components/fpspreadsheet/fpspreadsheetctrls.pas @@ -957,6 +957,8 @@ procedure TsWorkbookSource.SaveToSpreadsheetFile(AFileName: String; begin if FWorkbook <> nil then begin FWorkbook.WriteToFile(AFileName, AFormat, AOverwriteExisting); + FFileName := AFilename; + FFileFormat := AFormat; // If required, display loading error message if FWorkbook.ErrorMsg <> '' then @@ -1210,13 +1212,13 @@ begin begin rng := FWorksheet.GetSelection[j]; r := rng.Row1; - while (r <= rng.Row2) do begin + while (r <= longInt(rng.Row2)) do begin c := rng.Col1; - while (c <= rng.Col2) do begin + while (c <= LongInt(rng.Col2)) do begin for i:=0 to CellClipboard.Count-1 do begin cell := CellClipboard.CellByIndex[i]; - destRow := r + LongInt(cell^.Row) - baserng.Row1; - destCol := c + LongInt(cell^.Col) - baserng.Col1; + destRow := r + LongInt(cell^.Row) - LongInt(baserng.Row1); + destCol := c + LongInt(cell^.Col) - LongInt(baserng.Col1); case AItem of coCopyCell: FWorksheet.CopyCell(cell^.Row, cell^.Col, destRow, destCol); @@ -2613,6 +2615,7 @@ var cb: TsCellBorder; r1, r2, c1, c2: Cardinal; fmt: TsCellFormat; + numFmt: TsNumFormatParams; begin if (ACell <> nil) then fmt := Workbook.GetCellFormat(ACell^.FormatIndex) @@ -2687,13 +2690,16 @@ begin if (ACell = nil) or not (uffNumberFormat in fmt.UsedFormattingFields) then begin + AStrings.Add('NumberFormatIndex=-1'); AStrings.Add('NumberFormat=(default)'); AStrings.Add('NumberFormatStr=(none)'); end else begin + AStrings.Add(Format('NumberFormatIndex=%d', [fmt.NumberFormatIndex])); + numFmt := Workbook.GetNumberFormat(fmt.NumberFormatIndex); AStrings.Add(Format('NumberFormat=%s', [ - GetEnumName(TypeInfo(TsNumberFormat), ord(fmt.NumberFormat))])); - AStrings.Add('NumberFormatStr=' + fmt.NumberFormatStr); + GetEnumName(TypeInfo(TsNumberFormat), ord(numFmt.NumFormat))])); + AStrings.Add('NumberFormatStr=' + numFmt.NumFormatStr[nfdDefault]); end; if (Worksheet = nil) or not Worksheet.IsMerged(ACell) then diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index ff79f9099..565b410cd 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -19,7 +19,11 @@ unit fpspreadsheetgrid; - When Lazarus 1.4 comes out remove the workaround for the RGB2HLS bug in FindNearestPaletteIndex. - Arial bold is not shown as such if loaded from ods - - Background color of first cell is ignored. } + - Background color of first cell is ignored. + + - Enter 1234567890 into a cell. reduce col width with mouse. Immediately + before display becomes #### there is 11E09 in the cell - it should be 1E09. + Cell not correctly erased? } interface @@ -585,7 +589,7 @@ procedure Register; implementation uses - Types, LCLType, LCLIntf, LCLProc, Math, + Types, LCLType, LCLIntf, LCLProc, Math, StrUtils, fpCanvas, fpsStrings, fpsUtils, fpsVisualUtils; const @@ -1334,6 +1338,9 @@ var style: TFontStyles; isSelected: Boolean; fgcolor, bgcolor: TColor; + numFmt: TsNumFormatParams; + sidx: Integer; + clr: Integer; begin GetSelectedState(AState, isSelected); Canvas.Font.Assign(Font); @@ -1367,6 +1374,7 @@ begin if lCell <> nil then begin fmt := Workbook.GetPointerToCellFormat(lCell^.FormatIndex); + numFmt := Workbook.GetNumberFormat(fmt^.NumberFormatIndex); // Background color if (uffBackground in fmt^.UsedFormattingFields) then @@ -1424,10 +1432,26 @@ begin if fssStrikeout in fnt.Style then Include(style, fsStrikeout); Canvas.Font.Style := style; end; + if not IsNaN(lCell^.NumberValue) and (numFmt <> nil) then + begin + sidx := 0; + if (Length(numFmt.Sections) > 1) and (lCell^.NumberValue < 0) then + sidx := 1 + else + if (Length(numFmt.Sections) > 2) and (lCell^.NumberValue = 0) then + sidx := 2; + if numFmt.Sections[sidx].Elements[0].Token = nftColor then + begin + clr := numFmt.Sections[sidx].Elements[0].IntValue; + Canvas.Font.Color := Workbook.GetPaletteColor(clr); + end; + end; + { if (fmt^.NumberFormat = nfCurrencyRed) and not IsNaN(lCell^.NumberValue) and (lCell^.NumberValue < 0) then Canvas.Font.Color := Workbook.GetPaletteColor(scRed); + } // Wordwrap, text alignment and text rotation are handled by "DrawTextInCell". end; end; @@ -3834,8 +3858,10 @@ var p: Integer; isRotated: Boolean; isStacked: Boolean; - tr: TsTextRotation; fmt: PsCellFormat; + numFmt: TsNumFormatParams; + nfs: String; + isGeneralFmt: Boolean; begin Result := Worksheet.ReadAsUTF8Text(ACell); if (Result = '') or ((ACell <> nil) and (ACell^.ContentType = cctUTF8String)) @@ -3843,11 +3869,10 @@ begin exit; fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); - tr := fmt^.TextRotation; - isRotated := (tr <> trHorizontal); - isStacked := (tr = rtStacked); -// isRotated := (uffTextRotation in ACell^.UsedFormattingFields) and (ACell^.TextRotation <> trHorizontal); -// isStacked := (uffTextRotation in ACell^.UsedFormattingFields) and (ACell^.TextRotation = rtStacked); + isRotated := (fmt^.TextRotation <> trHorizontal); + isStacked := (fmt^.TextRotation = rtStacked); + numFmt := Workbook.GetNumberFormat(fmt^.NumberFormatIndex); + isGeneralFmt := (numFmt = nil); // Determine space available in cell if isRotated then @@ -3865,7 +3890,7 @@ begin if txtSize <= cellSize then exit; - if (ACell^.ContentType = cctNumber) and (fmt^.NumberFormat = nfGeneral) then + if (ACell^.ContentType = cctNumber) and isGeneralFmt then begin // Determine number of decimal places p := pos(Workbook.FormatSettings.DecimalSeparator, Result); @@ -3893,7 +3918,9 @@ begin while decs > 0 do begin dec(decs); - Result := Format('%.*e', [decs, ACell^.NumberValue], Workbook.FormatSettings); + nfs := '0.' + DupeString('0', decs) + 'E-00'; + Result := FormatFloat(nfs, ACell^.NumberValue, Workbook.FormatSettings); +// Result := Format('%.*e', [decs, ACell^.NumberValue], Workbook.FormatSettings); if isStacked then txtSize := Length(Result) * Canvas.TextHeight('A') else @@ -3966,6 +3993,8 @@ var lRow: PRow; h: Integer; begin + Unused(AStartIndex); + { BeginUpdate; if AStartIndex <= 0 then AStartIndex := FHeaderCount; diff --git a/components/fpspreadsheet/fpsreaderwriter.pas b/components/fpspreadsheet/fpsreaderwriter.pas index ca3e346cc..5884df6d8 100644 --- a/components/fpspreadsheet/fpsreaderwriter.pas +++ b/components/fpspreadsheet/fpsreaderwriter.pas @@ -20,7 +20,7 @@ interface uses Classes, Sysutils, AVL_Tree, - fpsTypes, fpsClasses, fpSpreadsheet, fpsNumFormat; + fpsTypes, fpsClasses, fpSpreadsheet; type {@@ @@ -38,10 +38,11 @@ type FVirtualCell: TCell; {@@ Stores if the reader is in virtual mode } FIsVirtualMode: Boolean; - {@@ List of number formats found in the file } - FNumFormatList: TsCustomNumFormatList; + {@@ List of number formats } + FNumFormatList: TStringList; { Helper methods } + procedure AddBuiltinNumFormats; virtual; {@@ Removes column records if all of them have the same column width } procedure FixCols(AWorksheet: TsWorksheet); {@@ Removes row records if all of them have the same row height } @@ -59,8 +60,6 @@ type {@@ Abstract method for reading a number cell. Must be overridden by descendent classes. } procedure ReadNumber(AStream: TStream); virtual; abstract; - procedure CreateNumFormatList; virtual; - public constructor Create(AWorkbook: TsWorkbook); override; destructor Destroy; override; @@ -71,7 +70,7 @@ type procedure ReadFromStrings(AStrings: TStrings); override; {@@ List of number formats found in the workbook. } - property NumFormatList: TsCustomNumFormatList read FNumFormatList; + property NumFormatList: TStringList read FNumFormatList; end; @@ -92,14 +91,15 @@ type TsCustomSpreadWriter = class(TsBasicSpreadWriter) protected {@@ List of number formats found in the file } - FNumFormatList: TsCustomNumFormatList; + FNumFormatList: TStringList; - procedure CreateNumFormatList; virtual; + procedure AddBuiltinNumFormats; virtual; + function FindNumFormatInList(ANumFormatStr: String): Integer; function FixColor(AColor: TsColor): TsColor; virtual; procedure FixFormat(ACell: PCell); virtual; procedure GetSheetDimensions(AWorksheet: TsWorksheet; out AFirstRow, ALastRow, AFirstCol, ALastCol: Cardinal); virtual; - procedure ListAllNumFormats; virtual; + procedure ListAllNumFormats(ADialect: TsNumFormatDialect); virtual; { Helpers for writing } procedure WriteCellToStream(AStream: TStream; ACell: PCell); @@ -133,7 +133,7 @@ type procedure WriteToStrings(AStrings: TStrings); override; {@@ List of number formats found in the workbook. } - property NumFormatList: TsCustomNumFormatList read FNumFormatList; + property NumFormatList: TStringList read FNumFormatList; end; {@@ List of registered formats } @@ -195,7 +195,8 @@ begin // Font list FFontList := TFPList.Create; // Number formats - CreateNumFormatList; + FNumFormatList := TStringList.Create; + AddBuiltinNumFormats; // Virtual mode FIsVirtualMode := (boVirtualMode in FWorkbook.Options) and Assigned(FWorkbook.OnReadCellData); @@ -219,15 +220,14 @@ begin end; {@@ ---------------------------------------------------------------------------- - Creates an instance of the number format list which contains prototypes of - all number formats found in the the file (when reading). + Adds the built-in number formats to the internal NumFormatList. - The method has to be overridden because the descendants know the special - requirements of the file format. + Must be overridden by descendants because they know about the details of + the file format. -------------------------------------------------------------------------------} -procedure TsCustomSpreadReader.CreateNumFormatList; +procedure TsCustomSpreadReader.AddBuiltinNumFormats; begin - // nothing to do here + // to be overridden by descendants end; {@@ ---------------------------------------------------------------------------- @@ -368,12 +368,13 @@ constructor TsCustomSpreadWriter.Create(AWorkbook: TsWorkbook); begin inherited Create(AWorkbook); // Number formats - CreateNumFormatList; + FNumFormatList := TStringList.Create; + AddBuiltinNumFormats; end; {@@ ---------------------------------------------------------------------------- Destructor of the writer. - Destroys the internal number format list and the error log list. + Destroys the internal number format list. -------------------------------------------------------------------------------} destructor TsCustomSpreadWriter.Destroy; begin @@ -382,15 +383,26 @@ begin end; {@@ ---------------------------------------------------------------------------- - Creates an instance of the number format list which contains prototypes of - all number formats found in the workbook . + Adds the built-in number formats to the NumFormatList The method has to be overridden because the descendants know the special requirements of the file format. -------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.CreateNumFormatList; +procedure TsCustomSpreadWriter.AddBuiltinNumFormats; begin - // nothing to do here + // to be overridden by descendents +end; + +{@@ ---------------------------------------------------------------------------- + Checks whether the specified number format string is already contained in the + the writer's internal number format list. If yes, the list index is returned. +-------------------------------------------------------------------------------} +function TsCustomSpreadWriter.FindNumFormatInList(ANumFormatStr: String): Integer; +begin + for Result:=0 to FNumFormatList.Count-1 do + if SameText(ANumFormatStr, FNumFormatList[Result]) then + exit; + Result := -1; end; {@@ ---------------------------------------------------------------------------- @@ -467,21 +479,24 @@ begin end; {@@ ---------------------------------------------------------------------------- - Iterates through all cells and collects the number formats in - FNumFormatList (without duplicates). - The index of the list item is needed for the field FormatIndex of the XF record. - At the time when the method is called the formats are still in fpc dialect. + Copies the format strings from the workbook's NumFormatList to the writer's + internal NumFormatList. -------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.ListAllNumFormats; +procedure TsCustomSpreadWriter.ListAllNumFormats(ADialect: TsNumFormatDialect); var i: Integer; - fmt: PsCellFormat; + numFmt: TsNumFormatParams; + numFmtStr: String; begin - for i:=0 to Workbook.GetNumCellFormats - 1 do + for i:=0 to Workbook.GetNumberFormatCount - 1 do begin - fmt := Workbook.GetPointerToCellFormat(i); - if FNumFormatList.Find(fmt^.NumberFormat, fmt^.NumberFormatStr) = -1 then - FNumFormatList.AddFormat(fmt^.NumberFormat, fmt^.NumberFormatStr); + numFmt := Workbook.GetNumberFormat(i); + if numFmt <> nil then + begin + numFmtStr := numFmt.NumFormatStr[ADialect]; + if FindNumFormatInList(numFmtStr) = -1 then + FNumFormatList.Add(numFmtStr); + end; end; end; @@ -534,7 +549,6 @@ var begin for cell in ACells do WriteCellToStream(AStream, cell); -// IterateThroughCells(AStream, ACells, WriteCellCallback); end; {@@ ---------------------------------------------------------------------------- diff --git a/components/fpspreadsheet/fpsstrings.pas b/components/fpspreadsheet/fpsstrings.pas index 911d936ea..1efafed55 100644 --- a/components/fpspreadsheet/fpsstrings.pas +++ b/components/fpspreadsheet/fpsstrings.pas @@ -31,6 +31,7 @@ resourcestring rsInvalidNumberFormat = 'Trying to use an incompatible number format.'; rsInvalidDateTimeFormat = 'Trying to use an incompatible date/time format.'; rsNoValidNumberFormatString = 'No valid number format string.'; + rsIsNoValidNumberFormatString = '%s is not a valid number format string.'; rsNoValidCellAddress = '"%s" is not a valid cell address.'; rsNoValidCellRangeAddress = '"%s" is not a valid cell range address.'; rsNoValidCellRangeOrCellAddress = '"%s" is not a valid cell or cell range address.'; @@ -77,11 +78,6 @@ resourcestring rsErrArgError = '#N/A'; rsErrFormulaNotSupported = ''; -(* - {%H-}rsNoValidDateTimeFormatString = 'No valid date/time format string.'; - {%H-}rsIllegalNumberFormat = 'Illegal number format.'; - *) - implementation end. diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas index 5e7b7682c..d55df33e4 100644 --- a/components/fpspreadsheet/fpstypes.pas +++ b/components/fpspreadsheet/fpstypes.pas @@ -196,27 +196,6 @@ type {@@ Describes which formatting fields are active } TsUsedFormattingFields = set of TsUsedFormattingField; - {@@ Number/cell formatting. Only uses a subset of the default formats, - enough to be able to read/write date/time values. - nfCustom allows to apply a format string directly. } - TsNumberFormat = ( - // general-purpose for all numbers - nfGeneral, - // numbers - nfFixed, nfFixedTh, nfExp, nfPercentage, nfFraction, - // currency - nfCurrency, nfCurrencyRed, - // dates and times - nfShortDateTime, {nfFmtDateTime, }nfShortDate, nfLongDate, nfShortTime, nfLongTime, - nfShortTimeAM, nfLongTimeAM, nfTimeInterval, - // other (format string goes directly into the file) - nfCustom); - - {@@ Identifies which "dialect" is used in the format strings: - nfdDefault is the dialect used by fpc - fndExcel is the dialect used by Excel } - TsNumFormatDialect = (nfdDefault, nfdExcel); - const { @@ Codes for curreny format according to FormatSettings.CurrencyFormat: "C" = currency symbol, "V" = currency value, "S" = space character @@ -450,6 +429,112 @@ type coEqual, coNotEqual, coLess, coGreater, coLessEqual, coGreaterEqual ); + {@@ Number/cell formatting. Only uses a subset of the default formats, + enough to be able to read/write date/time values. + nfCustom allows to apply a format string directly. } + TsNumberFormat = ( + // general-purpose for all numbers + nfGeneral, + // numbers + nfFixed, nfFixedTh, nfExp, nfPercentage, nfFraction, + // currency + nfCurrency, nfCurrencyRed, + // dates and times + nfShortDateTime, nfShortDate, nfLongDate, nfShortTime, nfLongTime, + nfShortTimeAM, nfLongTimeAM, nfDayMonth, nfMonthYear, nfTimeInterval, + // other (format string goes directly into the file) + nfCustom); + + {@@ Identifies which "dialect" is used in the format strings: + nfdDefault is the dialect used by fpc + fndExcel is the dialect used by Excel } + TsNumFormatDialect = (nfdDefault, nfdExcel); + + TsNumFormatToken = ( + nftText, // must be quoted, stored in TextValue + nftThSep, // ',', replaced by FormatSettings.ThousandSeparator + nftDecSep, // '.', replaced by FormatSettings.DecimalSeparator + nftYear, // 'y' or 'Y', count stored in IntValue + nftMonth, // 'm' or 'M', count stored in IntValue + nftDay, // 'd' or 'D', count stored in IntValue + nftHour, // 'h' or 'H', count stored in IntValue + nftMinute, // 'n' or 'N' (or 'm'/'M'), count stored in IntValue + nftSecond, // 's' or 'S', count stored in IntValue + nftMilliseconds, // 'z', 'Z', '0', count stored in IntValue + nftAMPM, // + nftMonthMinute, // 'm'/'M' or 'n'/'N', meaning depending on context + nftDateTimeSep, // '/' or ':', replaced by value from FormatSettings, stored in TextValue + nftSign, // '+' or '-', stored in TextValue + nftSignBracket, // '(' or ')' for negative values, stored in TextValue + nftIntOptDigit, // '#', count stored in IntValue + nftIntZeroDigit, // '0', count stored in IntValue + nftIntSpaceDigit, // '?', count stored in IntValue + nftIntTh, // '#,##0' sequence for nfFixed, count of 0 stored in IntValue + nftZeroDecs, // '0' after dec sep, count stored in IntValue + nftOptDecs, // '#' after dec sep, count stored in IntValue + nftSpaceDecs, // '?' after dec sep, count stored in IntValue + nftExpChar, // 'e' or 'E', stored in TextValue + nftExpSign, // '+' or '-' in exponent + nftExpDigits, // '0' digits in exponent, count stored in IntValue + nftPercent, // '%' percent symbol + nftFracSymbol, // '/' fraction symbol + nftFracNumOptDigit, // '#' in numerator, count stored in IntValue + nftFracNumSpaceDigit, // '?' in numerator, count stored in IntValue + nftFracNumZeroDigit, // '0' in numerator, count stored in IntValue + nftFracDenomOptDigit, // '#' in denominator, count stored in IntValue + nftFracDenomSpaceDigit,// '?' in denominator, count stored in IntValue + nftFracDenomZeroDigit, // '0' in denominator, count stored in IntValue + nftCurrSymbol, // e.g., '"$"', stored in TextValue + nftCountry, + nftColor, // e.g., '[red]', Color in IntValue + nftCompareOp, + nftCompareValue, + nftSpace, + nftEscaped, // '\' + nftRepeat, + nftEmptyCharWidth, + nftTextFormat); + + TsNumFormatElement = record + Token: TsNumFormatToken; + IntValue: Integer; + FloatValue: Double; + TextValue: String; + end; + + TsNumFormatElements = array of TsNumFormatElement; + + TsNumFormatKind = (nfkPercent, nfkExp, nfkCurrency, nfkFraction, nfkDate, nfkTime, nfkTimeInterval); + TsNumFormatKinds = set of TsNumFormatKind; + + TsNumFormatSection = record + Elements: TsNumFormatElements; + Kind: TsNumFormatKinds; + NumFormat: TsNumberFormat; + Decimals: Byte; + FracInt: Integer; + FracNumerator: Integer; + FracDenominator: Integer; + CurrencySymbol: String; + Color: TsColor; + end; + PsNumFormatSection = ^TsNumFormatSection; + + TsNumFormatSections = array of TsNumFormatSection; + + TsNumFormatParams = class(TObject) + protected + function GetNumFormat: TsNumberFormat; virtual; + function GetNumFormatStr(ADialect: TsNumFormatDialect): String; virtual; + public + Sections: TsNumFormatSections; + function SectionsEqualTo(ASections: TsNumFormatSections): Boolean; + property NumFormat: TsNumberFormat read GetNumFormat; + property NumFormatStr[ADialect: TsNumFormatDialect]: String read GetNumFormatStr; + end; + + TsNumFormatParamsClass = class of TsNumFormatParams; + {@@ Cell calculation state } TsCalcState = (csNotCalculated, csCalculating, csCalculated); @@ -512,6 +597,8 @@ type Border: TsCellBorders; BorderStyles: TsCelLBorderStyles; Background: TsFillPattern; + NumberFormatIndex: Integer; + // next two are deprecated... NumberFormat: TsNumberFormat; NumberFormatStr: String; end; @@ -573,9 +660,15 @@ type cctError : (ErrorValue: TsErrorValue); end; +function BuildFormatStringFromSection(const ASection: TsNumFormatSection; + ADialect: TsNumFormatDialect): String; + implementation +uses + StrUtils; + { TsCellFormatList } constructor TsCellFormatList.Create(AAllowDuplicates: Boolean); @@ -610,6 +703,7 @@ begin P^.Border := AItem.Border; P^.BorderStyles := AItem.BorderStyles; P^.Background := AItem.Background; + P^.NumberFormatIndex := AItem.NumberFormatIndex; P^.NumberFormat := AItem.NumberFormat; P^.NumberFormatStr := AItem.NumberFormatStr; Result := inherited Add(P); @@ -725,6 +819,7 @@ begin end; if (uffNumberFormat in AItem.UsedFormattingFields) then begin + if (P^.NumberFormatIndex <> AItem.NumberFormatIndex) then continue; if (P^.NumberFormat <> AItem.NumberFormat) then continue; if (P^.NumberFormatStr <> AItem.NumberFormatStr) then continue; end; @@ -743,5 +838,202 @@ begin end; +{ Creates a format string for the given section. This implementation covers + the formatstring dialects of fpc (nfdDefault) and Excel (nfdExcel). } +function BuildFormatStringFromSection(const ASection: TsNumFormatSection; + ADialect: TsNumFormatDialect): String; +var + element: TsNumFormatElement; + i: Integer; +begin + Result := ''; + + for i := 0 to High(ASection.Elements) do begin + element := ASection.Elements[i]; + case element.Token of + nftIntOptDigit, nftOptDecs, nftFracNumOptDigit, nftFracDenomOptDigit: + if element.IntValue > 0 then + Result := Result + DupeString('#', element.IntValue); + nftIntZeroDigit, nftZeroDecs, nftFracNumZeroDigit, nftFracDenomZeroDigit, nftExpDigits: + if element.IntValue > 0 then + Result := result + DupeString('0', element.IntValue); + nftIntSpaceDigit, nftSpaceDecs, nftFracNumSpaceDigit, nftFracDenomSpaceDigit: + if element.Intvalue > 0 then + Result := result + DupeString('?', element.IntValue); + nftIntTh: + case element.Intvalue of + 0: Result := Result + '#,###'; + 1: Result := Result + '#,##0'; + 2: Result := Result + '#,#00'; + 3: Result := Result + '#,000'; + end; + nftDecSep: + Result := Result + '.'; + nftThSep: + Result := Result + ','; + nftFracSymbol: + Result := Result + '/'; + nftPercent: + Result := Result + '%'; + nftSpace: + Result := Result + ' '; + nftText: + if element.TextValue <> '' then result := Result + '"' + element.TextValue + '"'; + 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); + nftMilliseconds: + if ADialect = nfdExcel then + Result := Result + Dupestring('0', element.IntValue) + else + Result := Result + DupeString('z', element.IntValue); + nftSign, nftSignBracket, nftExpChar, nftExpSign, 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 begin + 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; +end; + + +{ TsNumFormatParams } + +function TsNumFormatParams.GetNumFormat: TsNumberFormat; +begin + Result := nfCustom; + case Length(Sections) of + 0: Result := nfGeneral; + 1: Result := Sections[0].NumFormat; + 2: if (Sections[0].NumFormat = Sections[1].NumFormat) and + (Sections[0].NumFormat in [nfCurrency, nfCurrencyRed]) + then + Result := Sections[0].NumFormat; + 3: if (Sections[0].NumFormat = Sections[1].NumFormat) and + (Sections[1].NumFormat = Sections[2].NumFormat) and + (Sections[0].NumFormat in [nfCurrency, nfCurrencyRed]) + then + Result := Sections[0].NumFormat; + end; +end; + +function TsNumFormatParams.GetNumFormatStr(ADialect: TsNumFormatDialect): String; +var + i: Integer; +begin + if Length(Sections) > 0 then begin + Result := BuildFormatStringFromSection(Sections[0], ADialect); + for i := 1 to High(Sections) do + Result := Result + ';' + BuildFormatStringFromSection(Sections[i], ADialect); + end else + Result := ''; +end; + +function TsNumFormatParams.SectionsEqualTo(ASections: TsNumFormatSections): Boolean; +var + i, j: Integer; +begin + Result := false; + if Length(ASections) <> Length(Sections) then + exit; + for i := 0 to High(Sections) do begin + if Length(Sections[i].Elements) <> Length(ASections[i].Elements) then + exit; + + for j:=0 to High(Sections[i].Elements) do + begin + if Sections[i].Elements[j].Token <> ASections[i].Elements[j].Token then + exit; + + if Sections[i].NumFormat <> ASections[i].NumFormat then + exit; + if Sections[i].Decimals <> ASections[i].Decimals then + exit; + if Sections[i].FracInt <> ASections[i].FracInt then + exit; + if Sections[i].FracNumerator <> ASections[i].FracNumerator then + exit; + if Sections[i].FracDenominator <> ASections[i].FracDenominator then + exit; + if Sections[i].CurrencySymbol <> ASections[i].CurrencySymbol then + exit; + if Sections[i].Color <> ASections[i].Color then + exit; + + case Sections[i].Elements[j].Token of + nftText, nftThSep, nftDecSep, nftDateTimeSep, + nftAMPM, nftSign, nftSignBracket, + nftExpChar, nftExpSign, nftPercent, nftFracSymbol, nftCurrSymbol, + nftCountry, nftSpace, nftEscaped, nftRepeat, nftEmptyCharWidth, + nftTextFormat: + if Sections[i].Elements[j].TextValue <> ASections[i].Elements[j].TextValue + then exit; + + nftYear, nftMonth, nftDay, + nftHour, nftMinute, nftSecond, nftMilliseconds, + nftMonthMinute, + nftIntOptDigit, nftIntZeroDigit, nftIntSpaceDigit, nftIntTh, + nftZeroDecs, nftOptDecs, nftSpaceDecs, nftExpDigits, + nftFracNumOptDigit, nftFracNumSpaceDigit, nftFracNumZeroDigit, + nftFracDenomOptDigit, nftFracDenomSpaceDigit, nftFracDenomZeroDigit, + nftColor: + if Sections[i].Elements[j].IntValue <> ASections[i].Elements[j].IntValue + then exit; + + nftCompareOp, nftCompareValue: + if Sections[i].Elements[j].FloatValue <> ASections[i].Elements[j].FloatValue + then exit; + end; + end; + end; + Result := true; +end; + + end. diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index d916df50f..c729232f7 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -113,8 +113,6 @@ function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte; function AddIntervalBrackets(AFormatString: String): String; function DayNamesToString(const ADayNames: TWeekNameArray; const AEmptyStr: String): String; -procedure FloatToFraction(AValue: Double; AMaxNumerator, AMaxDenominator: Integer; - out ANumerator, ADenominator: Integer); function MakeLongDateFormat(ADateFormat: String): String; function MakeShortDateFormat(ADateFormat: String): String; function MonthNamesToString(const AMonthNames: TMonthNameArray; @@ -126,9 +124,12 @@ procedure SplitFormatString(const AFormatString: String; out APositivePart, procedure MakeTimeIntervalMask(Src: String; var Dest: String); +function ConvertFloatToStr(AValue: Double; AParams: TsNumFormatParams; + AFormatSettings: TFormatSettings): String; +procedure FloatToFraction(AValue, APrecision: Double; + AMaxNumerator, AMaxDenominator: Int64; out ANumerator, ADenominator: Int64); function TryStrToFloatAuto(AText: String; out ANumber: Double; out ADecimalSeparator, AThousandSeparator: Char; out AWarning: String): Boolean; - function TryFractionStrToFloat(AText: String; out ANumber: Double; out AMaxDigits: Integer): Boolean; @@ -172,6 +173,7 @@ procedure Unused(const A1); procedure Unused(const A1, A2); procedure Unused(const A1, A2, A3); + var {@@ Default value for the screen pixel density (pixels per inch). Is needed for conversion of distances to pixels} @@ -952,6 +954,9 @@ end; -------------------------------------------------------------------------------} function BuildDateTimeFormatString(ANumberFormat: TsNumberFormat; const AFormatSettings: TFormatSettings; AFormatString: String = '') : string; +var + i, j: Integer; + Unwanted: set of ansichar; begin case ANumberFormat of nfShortDateTime: @@ -977,9 +982,34 @@ begin if pos('a', lowercase(AFormatSettings.LongTimeFormat)) = 0 then Result := AddAMPM(Result, AFormatSettings); end; + nfDayMonth, // --> dd/mmm + nfMonthYear: // --> mmm/yy + begin + Result := AFormatSettings.ShortDateFormat; + case ANumberFormat of + nfDayMonth: + unwanted := ['y', 'Y']; + nfMonthYear: + unwanted := ['d', 'D']; + end; + for i:=Length(Result) downto 1 do + if Result[i] in unwanted then Delete(Result, i, 1); + while not (Result[1] in (['m', 'M', 'd', 'D', 'y', 'Y'] - unwanted)) do + Delete(Result, 1, 1); + while not (Result[Length(Result)] in (['m', 'M', 'd', 'D', 'y', 'Y'] - unwanted)) do + Delete(Result, Length(Result), 1); + i := 1; + while not (Result[i] in ['m', 'M']) do inc(i); + j := i; + while (j <= Length(Result)) and (Result[j] in ['m', 'M']) do inc(j); + while (j - i < 3) do begin + Insert(Result[i], Result, j); + inc(j); + end; + end; nfTimeInterval: // --> [h]:nn:ss if AFormatString = '' then - Result := '[h]:mm:ss' + Result := '[h]:nn:ss' else Result := AddIntervalBrackets(AFormatString); end; @@ -1115,7 +1145,8 @@ begin if ACurrencySymbol <> '' then begin Result := Format(p, ['#,##0' + decs, ACurrencySymbol]) + ';' - + IfThen(negRed and (ADialect = nfdExcel), '[red]', '') + + IfThen(negRed, '[red]', '') +// + IfThen(negRed and (ADialect = nfdExcel), '[red]', '') + Format(n, ['#,##0' + decs, ACurrencySymbol]) + ';' + Format(p, ['0'+decs, ACurrencySymbol]); end @@ -1343,89 +1374,76 @@ end; @param ANumerator (out) Numerator of the best approximating fraction @param ADenominator (out) Denominator of the best approximating fraction -------------------------------------------------------------------------------} -procedure FloatToFraction(AValue: Double; AMaxNumerator, AMaxDenominator: Integer; - out ANumerator, ADenominator: Integer); -// "Stern-Brocot-Tree" -// Original from : http://stackoverflow.com/questions/5124743/algorithm-for-simplifying-decimal-to-fractions -// Procedure adapted by forum user "circular": http://forum.lazarus.freepascal.org/index.php/topic,27805.msg172372.html#msg172372 +procedure FloatToFraction(AValue, APrecision: Double; + AMaxNumerator, AMaxDenominator: Int64; out ANumerator, ADenominator: Int64); +// Uses method of continued fractions, adapted version from a function in +// Bart Broersma's fractions.pp unit: +// http://svn.code.sf.net/p/flyingsheep/code/trunk/ConsoleProjecten/fractions/ +const + MaxInt64 = High(Int64); + MinInt64 = Low(Int64); var - n: Integer; - lower_n, lower_d, upper_n, upper_d, middle_n, middle_d: Integer; - isNeg: Boolean; - backup_num, backup_denom: Integer; - newResult_num, newResult_denom: Integer; - EPS: Double; + H1, H2, K1, K2, A, NewA, tmp, prevH1, prevK1: Int64; + B, diff, test, eps: Double; + Found, PendingOverflow: Boolean; + i: Integer = 0; begin - EPS := 0.01 / AMaxDenominator; + Assert((APrecision > 0) and (APrecision < 1)); - isNeg := AValue < 0; - if isNeg then - AValue := -AValue; + if (AValue > MaxInt64) or (AValue < MinInt64) then + raise Exception.Create('Range error'); - n := Trunc(AValue); - newResult_num := round(AValue); - newResult_denom := 1; - if isNeg then newResult_num := -newResult_num; - backup_num := newResult_num; - backup_denom := newResult_denom; - - AValue := AValue - n; - - // Lower fraction is 0/1 - lower_n := 0; - lower_d := 1; - - // Upper fraction is 1/1 - upper_n := 1; - upper_d := 1; - - while true do + if abs(AValue) < 0.5 / AMaxDenominator then begin - if abs(newResult_num/newResult_denom - n - AValue) < - abs(backup_num/backup_denom - n - AValue) - then begin - backup_num := newResult_num; - backup_denom := newResult_denom; - end; - - // middle fraction is (lower_n + upper_n) / (lower_d + upper_d) - middle_n := lower_n + upper_n; - middle_d := lower_d + upper_d; - newResult_num := n * middle_d + middle_n; - newResult_denom := middle_d; -// newResult.Normalize; - if (newResult_num > AMaxNumerator) or (newResult_denom > AMaxDenominator) - then begin - ANumerator := backup_num; - ADenominator := backup_denom; - exit; - end; - - if isNeg then newResult_num := -newResult_num; - - // AValue + EPS < middle - if middle_d * (AValue + EPS) < middle_n then - begin - // middle is our new upper - upper_n := middle_n; - upper_d := middle_d; - end else - // middle < AValue - EPS - if middle_n < (AValue - EPS) * middle_d then - begin - // middle is our new lower - lower_n := middle_n; - lower_d := middle_d; - end else - // middle is our best fraction - begin - ANumerator := newResult_num; - ADenominator := newResult_denom; - exit; - end; + ANumerator := 0; + ADenominator := AMaxDenominator; + exit; end; + + H1 := 1; + H2 := 0; + K1 := 0; + K2 := 1; + B := AValue; + NewA := Round(Floor(B)); + prevH1 := H1; + prevK1 := K1; + repeat + inc(i); + A := NewA; + tmp := H1; + H1 := A * H1 + H2; + H2 := tmp; + tmp := K1; + K1 := A * K1 + K2; + K2 := tmp; + test := H1/K1; + diff := test - AValue; + if (abs(diff) < APrecision) then + break; + if (abs(H1) > AMaxNumerator) or (abs(K1) > AMaxDenominator) then + begin + H1 := prevH1; + K1 := prevK1; + break; + end; + if (Abs(B - A) < 1E-30) then + B := 1E30 //happens when H1/K1 exactly matches Value + else + B := 1 / (B - A); + PendingOverFlow := (B * H1 + H2 > MaxInt64) or + (B * K1 + K2 > MaxInt64) or + (B > MaxInt64); + if not PendingOverflow then + NewA := Round(Floor(B)); + prevH1 := H1; + prevK1 := K1; + until PendingOverflow; + ANumerator := H1; + ADenominator := K1; end; + {@@ ---------------------------------------------------------------------------- Creates a long date format string out of a short date format string. Retains the order of year-month-day and the separators, but uses 4 digits @@ -2330,6 +2348,7 @@ begin FillChar(AValue, SizeOf(AValue), 0); AValue.BorderStyles := DEFAULT_BORDERSTYLES; AValue.Background := EMPTY_FILL; + AValue.NumberFormatIndex := -1; // GENERAL format not contained in NumFormatList end; {@@ ---------------------------------------------------------------------------- @@ -2373,6 +2392,725 @@ begin end; +{@@ ---------------------------------------------------------------------------- + Converts a floating point number to a string as determined by the specified + number format parameters +-------------------------------------------------------------------------------} +function ConvertFloatToStr(AValue: Double; AParams: TsNumFormatParams; + AFormatSettings: TFormatSettings): String; +var + fs: TFormatSettings absolute AFormatSettings; + sidx: Integer; + section: TsNumFormatSection; + i, p, q, el, numEl: Integer; + isNeg: Boolean; + yr, mon, day, hr, min, sec, ms: Word; + frInt, frNum, frDenom: Int64; + maxNum, maxDenom: Int64; + decsZero, decsOpt, decsSpace: Integer; + digitsZero, digitsOpt, digitsSpace: Integer; + numDigitsZero, numDigitsOpt, numDigitsSpace: Integer; + denomDigitsZero, denomDigitsOpt, denomDigitsSpace: Integer; + expSign: Char; + expDigits: Integer; + numStr, s: String; + terminatingTokens: set of TsNumFormatToken; + intTokens: set of TsNumFormatToken; + decsTokens: set of TsNumFormatToken; + fracNumTokens: set of TsNumFormatToken; + fracDenomTokens: set of TsNumFormatToken; + + function FixIntPart(AValue: Double; AddThousandSeparator: Boolean; + AZeroCount, AOptCount, ASpaceCount: Integer): String; + var + j: Integer; + isNeg: Boolean; + begin + isNeg := AValue < 0; + Result := IntToStr(trunc(abs(AValue))); + if (AZeroCount = 0) and (ASpaceCount = 0) then + begin + if Result = '0' then + Result := ''; + end else + if (AZeroCount > 0) and (ASpaceCount = 0) then + begin + while Length(Result) < AZeroCount do + Result := '0' + Result; + end else + if (AZeroCount = 0) and (ASpaceCount > 0) then + begin + while Length(Result) < AZeroCount do + Result := ' ' + Result; + end else + begin + while Length(Result) < AZeroCount do + Result := '0' + Result; + while Length(Result) < AZeroCount + ASpaceCount do + Result := ' ' + Result; + end; + if AddThousandSeparator then + begin + j := Length(Result)-2; + while (j > 0) do + begin + Insert(fs.ThousandSeparator, Result, j); + dec(j, 3); + end; + end; + if isNeg then + Result := '-' + Result; + end; + + function FixDecimals(AValue: Double; + AZeroCount, AOptCount, ASpaceCount: Integer): String; + var + j, decs: Integer; + begin + if AZeroCount + AOptCount + ASpaceCount = 0 then + begin + Result := ''; // no decimals in this case + exit; + end; + + Result := FloatToStrF(abs(frac(AValue)), ffFixed, 20, AZeroCount + AOptCount + ASpaceCount, fs); + Delete(Result, 1, 2); // Delete '0.' to extract the decimals + decs := Length(Result); + while decs < AZeroCount do begin + Result := Result + '0'; + inc(decs); + end; + + j := Length(Result); + while (Result[j] = '0') and (decs > AZeroCount) and (( decsOpt > 0) or (decsSpace > 0)) do + begin + if decsOpt > 0 then + begin + Delete(Result, j, 1); + dec(decs); + dec(decsOpt); + end else + if decsSpace > 0 then + begin + Result[j] := ' '; + dec(decs); + dec(decsOpt); + end; + dec(j); + end; + + if Result <> '' then + Result := fs.DecimalSeparator + Result; + end; + + procedure InvalidFormat; + var + fmtStr: String; + begin + fmtStr := AParams.NumFormatStr[nfdExcel]; + raise Exception.CreateFmt(rsIsNoValidNumberFormatString, [fmtStr]); + end; + +begin + Result := ''; + if IsNaN(AValue) then + exit; + + if AParams = nil then + begin + Result := FloatToStrF(AValue, ffGeneral, 20, 20, fs); + exit; + end; + + sidx := 0; + if (AValue < 0) and (Length(AParams.Sections) > 1) then + sidx := 1; + if (AValue = 0) and (Length(AParams.Sections) > 2) then + sidx := 2; + isNeg := (AValue < 0); + if (sidx > 0) and isNeg then + AValue := -AValue; + section := AParams.Sections[sidx]; + numEl := Length(section.Elements); + + terminatingTokens := [nftSpace, nftText, nftPercent, nftCurrSymbol, nftSignBracket, + nftEscaped]; + intTokens := [nftIntOptDigit, nftIntZeroDigit, nftIntSpaceDigit]; + decsTokens := [nftZeroDecs, nftOptDecs, nftSpaceDecs]; + fracNumTokens := [nftFracNumOptDigit, nftFracNumZeroDigit, nftFracNumSpaceDigit]; + fracDenomTokens := [nftFracDenomOptDigit, nftFracDenomZeroDigit, nftFracDenomSpaceDigit]; + + if nfkPercent in section.Kind then + AValue := AValue * 100.0; + if nfkTime in section.Kind then + DecodeTime(AValue, hr, min, sec, ms); + if nfkDate in section.Kind then + DecodeDate(AValue, yr, mon, day); + + el := 0; + while (el < numEl) do begin + case section.Elements[el].Token of + nftIntOptDigit, + nftIntZeroDigit, + nftIntSpaceDigit: + begin + // Decimals + decsZero := 0; + decsSpace := 0; + decsOpt := 0; + // Integer part of number format + digitsZero := 0; + digitsSpace := 0; + digitsOpt := 0; + i := el; + while (i < numEl) and (section.Elements[i].Token in intTokens) do + begin + case section.Elements[i].Token of + nftIntOptDigit : inc(digitsOpt, section.Elements[i].IntValue); + nftIntZeroDigit : inc(digitsZero, section.Elements[i].IntValue); + nftIntSpaceDigit: inc(digitsSpace, section.Elements[i].IntValue); + end; + inc(i); + end; + + { These are the cases that can occur: + (1) number w/ decimals ---> end of line + (2) number w/ decimals --> space, terminating tokens + (3) number w/ decimals --> exponent + (4) number w/o decimals --> end of line + (5) number w/o decimals --> space, terminating tokens + (6) number w/o decimals --> space --> numerator --> '/' --> denominator + (7) number w/o decimals --> exponent + } + // Integer only, followed by end-of-line (case 4) + if (i = numEl) or (section.Elements[i].Token in (terminatingTokens - [nftSpace])) then + begin + Result := Result + FixIntPart(AValue, false, digitsZero, digitsOpt, digitsSpace); + el := i; + Continue; + end; + + if (i < numEl) then + begin + // Check for Exponent (format '0E+00', case 7) + if (section.Elements[i].Token = nftExpChar) then begin + inc(i); + if (i < numEl) and (section.Elements[i].Token = nftExpSign) then begin + expSign := section.Elements[i].TextValue[1]; + inc(i); + if (i < numEl) and (section.Elements[i].Token = nftExpDigits) then + expDigits := section.Elements[i].IntValue + else + InvalidFormat; + end else + InvalidFormat; + numStr := FormatFloat('0E'+expSign+DupeString('0', expDigits), AValue, fs); + p := pos('e', Lowercase(numStr)); + s := copy(numStr, p, Length(numStr)); // E part of the number string + numStr := copy(numStr, 1, p-1); // Mantissa of the number string + Result := Result + + FixIntPart(StrToFloat(numStr, fs), false, digitsZero, digitsOpt, digitsSpace) + s; + el := i; + Continue; + end; + + // Check for decimal separator + if (section.Elements[i].Token = nftDecSep) then + begin + // Yes, cases (1) or (2) -- get decimal specification + decsZero := 0; + decsSpace := 0; + decsOpt := 0; + inc(i); + while (i < numEl) and (section.Elements[i].Token in decsTokens) do + begin + case section.Elements[i].Token of + nftZeroDecs : inc(decsZero, section.Elements[i].IntValue); + nftOptDecs : inc(decsOpt, section.Elements[i].IntValue); + nftSpaceDecs: inc(decsSpace, section.Elements[i].IntValue); + end; + inc(i); + end; + + // Simple decimal number (nfFixed), followed by eol (case 1) + if (i = numEl) then + begin + // Simple decimal number (nfFixed) (case 1) + Result := Result + + FixIntPart(AValue, false, digitsZero, digitsOpt, digitsSpace) + + FixDecimals(AValue, decsZero, decsOpt, decsSpace); + el := i; + Continue; + end; + + // Check for exponential format (case 3) + if (section.Elements[i].Token = nftExpChar) then + begin + inc(i); + if (i < numEl) and (section.Elements[i].Token = nftExpSign) then begin + expSign := section.Elements[i].TextValue[1]; + inc(i); + if (i < numEl) and (section.Elements[i].Token = nftExpDigits) then + expDigits := section.Elements[i].IntValue + else + InvalidFormat; + end else + InvalidFormat; + numStr := FloatToStrF(AValue, ffExponent, decsZero+decsOpt+decsSpace+1, expDigits, fs); + if (abs(AValue) >= 1.0) and (expSign = '-') then + Delete(numStr, pos('+', numStr), 1); + p := pos('e', Lowercase(numStr)); + s := copy(numStr, p, Length(numStr)); // E part of the number string + numStr := copy(numStr, 1, p-1); // Mantissa of the number string + q := pos(fs.DecimalSeparator, numStr); + Result := Result + + FixIntPart(StrToFloat(numStr, fs), false, digitsZero, digitsOpt, digitsSpace); + if q = 0 then + Result := Result + s + else + Result := Result + FixDecimals(StrToFloat(numStr, fs), decsZero, decsOpt, decsSpace) + s; + el := i; + Continue; + end; + end; + + // Check for fraction (case 6) + if (section.Elements[i].Token = nftSpace) or + ((section.Elements[i].Token = nftText) and (section.Elements[i].TextValue = ' ')) then + begin + inc(i); + if (i < numEl) and (section.Elements[i].Token in fracNumTokens) then + begin + // Process numerator + numDigitsZero := 0; + numDigitsSpace := 0; + numDigitsOpt := 0; + while (i < numEl) and (section.Elements[i].Token in fracNumTokens) do + begin + case section.Elements[i].Token of + nftFracNumOptDigit : inc(numDigitsOpt, section.Elements[i].IntValue); + nftFracNumZeroDigit : inc(numDigitsZero, section.Elements[i].IntValue); + nftFracNumSpaceDigit: inc(numDigitsSpace, section.Elements[i].IntValue); + end; + inc(i); + end; + // Skip spaces before '/' symbol, find '/' + while (i < numEl) and (section.Elements[i].Token <> nftFracSymbol) do + inc(i); + // Skip spaces after '/' symbol, find denominator + while (i < numEl) and not (section.Elements[i].Token in fracDenomTokens) do + inc(i); + // Process denominator + denomDigitsZero := 0; + denomDigitsOpt := 0; + denomDigitsSpace := 0; + while (i < numEl) and (section.Elements[i].Token in fracDenomTokens) do + begin + case section.Elements[i].Token of + nftFracDenomOptDigit : inc(denomDigitsOpt, section.Elements[i].IntValue); + nftFracDenomZeroDigit : inc(denomDigitsZero, section.Elements[i].IntValue); + nftFracDenomSpaceDigit: inc(denomDigitsSpace, section.Elements[i].IntValue); + end; + inc(i); + end; + + // Calculate fraction + maxNum := Round(IntPower(10, numDigitsOpt+numDigitsZero+numDigitsSpace)); + maxDenom := Round(IntPower(10, denomDigitsOpt+denomDigitsZero+denomDigitsSpace)); + if (digitsOpt = 0) and (digitsSpace = 0) and (digitsZero = 0) then + begin + frint := 0; + s := ''; + end else begin + frint := trunc(abs(AValue)); + AValue := frac(abs(AValue)); + s := IntToStr(frInt); + end; + FloatToFraction(abs(AValue), 0.1/maxdenom, maxnum, maxdenom, frnum, frdenom); + + if frInt > 0 then + Result := Result + + FixIntPart(frInt, false, digitsZero, digitsOpt, digitsSpace); + Result := Result + + ' ' + + FixIntPart(frnum, false, numDigitsZero, numDigitsOpt, numDigitsSpace) + + '/' + + FixIntPart(frdenom, false, denomDigitsZero, denomDigitsOpt, denomDigitsSpace); + if isNeg then + Result := '-' + Result; + el := i; + Continue; + end; + end; + + // Simple decimal number (nfFixed), followed by terminating tokens (case 5) + if (i < numEl) and (section.Elements[i].Token in terminatingTokens) then + begin + // Simple decimal number (nfFixed) (case 1) + Result := Result + + FixIntPart(AValue, false, digitsZero, digitsOpt, digitsSpace) + + FixDecimals(AValue, decsZero, decsOpt, decsSpace); + el := i; + Continue; + end; + end; + end; + + nftIntTh: // Format with thousand separator + begin + terminatingTokens := [nftSpace, nftText, nftPercent, nftCurrSymbol, + nftSignBracket, nftEscaped]; + decsTokens := [nftZeroDecs, nftOptDecs, nftSpaceDecs]; + decsZero := 0; + decsSpace := 0; + decsOpt := 0; + digitsZero := section.Elements[el].IntValue; + i := el+1; + if (i < numEl) and (section.Elements[i].Token = nftDecSep) then + begin + inc(i); + while (i < numEl) and (section.Elements[i].Token in [nftZeroDecs, nftOptDecs, nftSpaceDecs]) do + begin + case section.Elements[i].Token of + nftZeroDecs : inc(decsZero, section.Elements[i].IntValue); + nftOptDecs : inc(decsOpt, section.Elements[i].IntValue); + nftSpaceDecs: inc(decsSpace, section.Elements[i].IntValue); + end; + inc(i); + end; + end; + Result := Result + FixIntPart(AValue, true, digitsZero, 0, 0) + + FixDecimals(AValue, decsZero, DecsOpt, decsSpace); + el := i; + Continue; + end; + + nftFracNumZeroDigit, + nftFracNumOptDigit, + nftFracNumSpaceDigit: + begin + // Process numerator + numDigitsZero := 0; + numDigitsSpace := 0; + numDigitsOpt := 0; + i := el; + while (i < numEl) and (section.Elements[i].Token in fracNumTokens) do + begin + case section.Elements[i].Token of + nftFracNumOptDigit : inc(numDigitsOpt, section.Elements[i].IntValue); + nftFracNumZeroDigit : inc(numDigitsZero, section.Elements[i].IntValue); + nftFracNumSpaceDigit: inc(numDigitsSpace, section.Elements[i].IntValue); + end; + inc(i); + end; + // Skip spaces before '/' symbol, find '/' + while (i < numEl) and (section.Elements[i].Token <> nftFracSymbol) do + inc(i); + // Skip spaces after '/' symbol, find denominator + while (i < numEl) and not (section.Elements[i].Token in fracDenomTokens) do + inc(i); + // Process denominator + denomDigitsZero := 0; + denomDigitsOpt := 0; + denomDigitsSpace := 0; + while (i < numEl) and (section.Elements[i].Token in fracDenomTokens) do + begin + case section.Elements[i].Token of + nftFracDenomOptDigit : inc(denomDigitsOpt, section.Elements[i].IntValue); + nftFracDenomZeroDigit : inc(denomDigitsZero, section.Elements[i].IntValue); + nftFracDenomSpaceDigit: inc(denomDigitsSpace, section.Elements[i].IntValue); + end; + inc(i); + end; + + // Calculate fraction + maxNum := Round(IntPower(10, numDigitsOpt+numDigitsZero+numDigitsSpace)); + maxDenom := Round(IntPower(10, denomDigitsOpt+denomDigitsZero+denomDigitsSpace)); + FloatToFraction(abs(AValue), 0.1/maxdenom, MaxInt, maxdenom, frnum, frdenom); + if isNeg then + Result := Result + '-'; + Result := Result + + FixIntPart(frnum, false, numDigitsZero, numDigitsOpt, numDigitsSpace) + + '/' + + FixIntPart(frdenom, false, denomDigitsZero, denomDigitsOpt, denomDigitsSpace); + el := i-1; + end; + + nftSpace: + Result := Result + ' '; + + nftText: + Result := Result + section.Elements[el].TextValue; + + nftEscaped: + begin + inc(el); + if el < Length(section.Elements) then + Result := Result + section.Elements[el].TextValue; + end; + + nftDateTimeSep: + case section.Elements[el].TextValue of + '/': Result := Result + fs.DateSeparator; + ':': Result := Result + fs.TimeSeparator; + else Result := Result + section.Elements[el].TextValue; + end; + + nftDecSep: + Result := Result + fs.DecimalSeparator; + + nftThSep: + Result := Result + fs.ThousandSeparator; + + nftSign, nftSignBracket, nftCurrSymbol: + Result := Result + section.Elements[el].TextValue; + + nftPercent: + Result := Result + '%'; + + nftYear: + case section.Elements[el].IntValue of + 1, + 2: Result := Result + IfThen(yr mod 100 < 10, '0'+IntToStr(yr mod 100), IntToStr(yr mod 100)); + 4: Result := Result + IntToStr(yr); + end; + + nftMonth: + case section.Elements[el].IntValue of + 1: Result := Result + IntToStr(mon); + 2: Result := Result + IfThen(mon < 10, '0'+IntToStr(mon), IntToStr(mon)); + 3: Result := Result + fs.ShortMonthNames[mon]; + 4: Result := Result + fs.LongMonthNames[mon]; + end; + + nftDay: + case section.Elements[el].IntValue of + 1: result := result + IntToStr(day); + 2: result := Result + IfThen(day < 10, '0'+IntToStr(day), IntToStr(day)); + 3: Result := Result + fs.ShortDayNames[day]; + 4: Result := Result + fs.LongDayNames[day]; + end; + + nftHour: + begin + if section.Elements[el].IntValue < 0 then // This case is for nfTimeInterval + s := IntToStr(Int64(hr) + trunc(AValue) * 24) + else + if section.Elements[el].TextValue = 'AM' then // This tag is set in case of AM/FM format + begin + hr := hr mod 12; + if hr = 0 then hr := 12; + s := IntToStr(hr) + end else + s := IntToStr(hr); + if (abs(section.Elements[el].IntValue) = 2) and (Length(s) = 1) then + s := '0' + s; + Result := Result + s; + end; + + nftMinute: + begin + if section.Elements[el].IntValue < 0 then // case for nfTimeInterval + s := IntToStr(int64(min) + trunc(AValue) * 24 * 60) + else + s := IntToStr(min); + if (abs(section.Elements[el].IntValue) = 2) and (Length(s) = 1) then + s := '0' + s; + Result := Result + s; + end; + + nftSecond: + begin + if section.Elements[el].IntValue < 0 then // case for nfTimeInterval + s := IntToStr(Int64(sec) + trunc(AValue) * 24 * 60 * 60) + else + s := IntToStr(sec); + if (abs(section.Elements[el].IntValue) = 2) and (Length(s) = 1) then + s := '0' + s; + Result := Result + s; + end; + + nftMilliseconds: + case section.Elements[el].IntValue of + 1: Result := Result + IntToStr(ms div 100); + 2: Result := Result + Format('%02d', [ms div 10]); + 3: Result := Result + Format('%03d', [ms]); + end; + + nftAMPM: + begin + s := section.Elements[el].TextValue; + if lowercase(s) = 'ampm' then + s := IfThen(frac(AValue) < 0.5, fs.TimeAMString, fs.TimePMString) + else + begin + i := pos('/', s); + if i > 0 then + s := IfThen(frac(AValue) < 0.5, copy(s, 1, i-1), copy(s, i+1, Length(s))) + else + s := IfThen(frac(AValue) < 0.5, 'AM', 'PM'); + end; + Result := Result + s; + end; + end; + inc(el); + end; + + (* + section := AParams.Sections[sidx]; + nf := section.NumFormat; + case nf of + nfFixed: + Result := FloatToStrF(AValue, ffFixed, 20, section.Decimals, fs); + nfFixedTh: + Result := FloatToStrF(AValue, ffNumber, 20, section.Decimals, fs); + nfPercentage: + Result := FloatToStrF(AValue*100.0, ffFixed, 20, section.Decimals, fs) + '%'; + nfExp: + begin + elem := High(Section.Elements); + expDigits := 2; + if section.Elements[elem].Token = nftExpDigits then + expDigits := section.Elements[elem].IntValue; + Result := FloatToStrF(AValue, ffExponent, section.Decimals+1, expDigits, fs); + if (abs(AValue) >= 1.0) and ( + ((section.Elements[elem-1].Token <> nftExpSign) or (section.Elements[elem-1].TextValue = '-')) ) + then + Delete(Result, pos('+', Result), 1); + end; + nfFraction: + begin + AValue := abs(AValue); + if section.FracInt = 0 then + frint := 0 + else begin + frint := trunc(AValue); + AValue := frac(AValue); + end; + maxNum := Round(IntPower(10, section.FracNumerator)); + maxDenom := Round(IntPower(10, section.FracDenominator)); + FloatToFraction(AValue, maxnum, maxdenom, frnum, frdenom); + Result := IntToStr(frnum) + '/' + IntToStr(frdenom); + if frint <> 0 then + Result := IntToStr(frint) + ' ' + result; + if isNeg then Result := '-' + Result; + end; + nfCurrency, + nfCurrencyRed: + begin + valueDone := false; + for elem := 0 to High(section.Elements) do + case section.Elements[elem].Token of + nftSpace: + Result := Result + ' '; + nftText: + Result := Result + section.Elements[elem].TextValue; + nftCurrSymbol: + Result := Result + section.CurrencySymbol; + nftSign: + Result := Result + '-'; + nftSignBracket: + Result := Result + section.Elements[elem].TextValue; + nftDigit, nftOptDigit: + if not ValueDone then + begin + Result := Result + FloatToStrF(AValue, ffNumber, 20, section.Decimals, fs); + valueDone := true; + end; + end; + end; + nfShortDate, nfLongDate, nfShortTime, nfLongTime, nfShortDateTime, + nfShortTimeAM, nfLongTimeAM: + begin + DecodeDate(trunc(AValue), yr, mon, day); + DecodeTime(frac(AValue), hr, min, sec, ms); + elem := 0; + while elem < Length(section.Elements) do + begin + case section.Elements[elem].Token of + nftSpace: + Result := Result + ' '; + nftText: + Result := Result + section.Elements[elem].TextValue; + nftYear: + case section.Elements[elem].IntValue of + 1, + 2: Result := Result + IfThen(yr < 10, '0'+IntToStr(yr), IntToStr(yr)); + 4: Result := Result + IntToStr(yr); + end; + nftMonth: + case section.Elements[elem].IntValue of + 1: Result := Result + IntToStr(mon); + 2: Result := Result + IfThen(mon < 10, '0'+IntToStr(mon), IntToStr(mon)); + 3: Result := Result + fs.ShortMonthNames[mon]; + 4: Result := Result + fs.LongMonthNames[mon]; + end; + nftDay: + case section.Elements[elem].IntValue of + 1: result := result + IntToStr(day); + 2: result := Result + IfThen(day < 10, '0'+IntToStr(day), IntToStr(day)); + 3: Result := Result + fs.ShortDayNames[day]; + 4: Result := Result + fs.LongDayNames[day]; + end; + nftHour: + begin + if section.Elements[elem].IntValue < 0 then + hr := hr + trunc(AValue) * 24; + case abs(section.Elements[elem].IntValue) of + 1: Result := Result + IntToStr(hr); + 2: Result := Result + IfThen(hr < 10, '0'+IntToStr(hr), IntToStr(hr)); + end; + end; + nftMinute: + begin + if section.Elements[elem].IntValue < 0 then + min := min + trunc(AValue) * 24 * 60; + case abs(section.Elements[elem].IntValue) of + 1: Result := Result + IntToStr(min); + 2: Result := Result + IfThen(min < 10, '0'+IntToStr(min), IntToStr(min)); + end; + end; + nftSecond: + begin + if section.Elements[elem].IntValue < 0 then + sec := sec + trunc(AValue) * 24 * 60 * 60; + case abs(section.Elements[elem].IntValue) of + 1: Result := Result + IntToStr(sec); + 2: Result := Result + IfThen(sec < 10, '0'+IntToStr(sec), IntToStr(sec)); + end; + end; + nftDecSep: + Result := Result + fs.DecimalSeparator; + nftMilliseconds: + case section.Elements[elem].IntValue of + 1: Result := Result + IntToStr(ms div 100); + 2: Result := Result + Format('%02d', [ms div 10]); + 3: Result := Result + Format('%03d', [ms]); + end; + nftDateTimeSep: + case section.Elements[elem].TextValue of + '/': Result := Result + fs.DateSeparator; + ':': Result := Result + fs.TimeSeparator; + else Result := Result + section.Elements[elem].TextValue; + end; + nftAMPM: + if frac(AValue) <= 0.5 then + Result := Result + fs.TimeAMString + else + Result := Result + fs.TimePMString; + nftEscaped: + begin + inc(elem); + Result := Result + section.Elements[elem].TextValue; + end; + end; + inc(elem); + end; + end; + end;*) +end; + + { Modifying colors } { Next function are copies of GraphUtils to avoid a dependence on the Graphics unit. } diff --git a/components/fpspreadsheet/tests/datetests.pas b/components/fpspreadsheet/tests/datetests.pas index 39ac20804..0013ad659 100644 --- a/components/fpspreadsheet/tests/datetests.pas +++ b/components/fpspreadsheet/tests/datetests.pas @@ -467,7 +467,7 @@ var begin ErrorMargin := 1E-5/(24*60*60*1000); // = 10 nsec = 1E-8 sec (1 ns fails) - if Row>High(SollDates) then + if Row > High(SollDates) then fail('Error in test code: array bounds overflow. Check array size is correct.'); // Load the file only if is the file name changes. diff --git a/components/fpspreadsheet/tests/formattests.pas b/components/fpspreadsheet/tests/formattests.pas index 70411313b..f09ee214c 100644 --- a/components/fpspreadsheet/tests/formattests.pas +++ b/components/fpspreadsheet/tests/formattests.pas @@ -230,8 +230,14 @@ begin 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] := FormatCurr('"€"#,##0;("€"#,##0)', SollNumbers[i], fs); SollNumberStrings[i, 9] := FormatCurr('"€"#,##0.00;("€"#,##0.00)', SollNumbers[i], fs); + } + // Don't use FormatCurr for the next two cases because is reports the sign of + // very small numbers inconsistenly with the spreadsheet applications. + SollNumberStrings[i, 8] := FormatFloat('"€"#,##0;("€"#,##0)', SollNumbers[i], fs); + SollNumberStrings[i, 9] := FormatFloat('"€"#,##0.00;("€"#,##0.00)', SollNumbers[i], fs); end; // Date/time values @@ -384,7 +390,7 @@ begin MyWorkbook := TsWorkbook.Create; try MyWorkbook.FormatSettings.CurrencyString := '€'; // use € for checking UTF8 issues - MyWorkbook.FormatSettings.Currencyformat := pcfCV; // €100 + MyWorkbook.FormatSettings.Currencyformat := pcfCV; // €100 Myworkbook.FormatSettings.NegCurrFormat := ncfBCVB; // (€100) MyWorkbook.ReadFromFile(TempFile, AFormat); if AFormat in [sfExcel2, sfCSV] then diff --git a/components/fpspreadsheet/tests/internaltests.pas b/components/fpspreadsheet/tests/internaltests.pas index ab8ffc22f..beb543a02 100644 --- a/components/fpspreadsheet/tests/internaltests.pas +++ b/components/fpspreadsheet/tests/internaltests.pas @@ -51,6 +51,8 @@ type // Test buffered stream procedure TestReadBufStream; procedure TestWriteBufStream; + // Test fractions + procedure FractionTest; end; implementation @@ -395,6 +397,26 @@ begin CheckEquals(s, GetCellString(r, c, flags)); end; +procedure TSpreadInternalTests.FractionTest; +const + N = 300; + DIGITS = 3; +var + i, j: Integer; + sollNum, sollDenom: Integer; + sollValue: Double; + actualNum, actualDenom: Int64; +begin + sollNum := 1; + for j := 1 to N do + begin + sollDenom := j; + sollValue := StrToFloat(FormatFloat('0.00000', sollNum/sollDenom)); + FloatToFraction(sollvalue, 0.1/DIGITS, DIGITS, DIGITS, actualNum, actualDenom); + if actualDenom > sollDenom then + fail(Format('Conversion error: approximated %d/%d turns to %d/%d', [sollNum, sollDenom, actualNum, actualDenom])); + end; +end; procedure TSpreadInternalTests.SetUp; begin diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi index f6cc40615..7ea7c1714 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpi +++ b/components/fpspreadsheet/tests/spreadtestgui.lpi @@ -53,10 +53,12 @@ + + @@ -69,6 +71,7 @@ + @@ -91,6 +94,7 @@ + diff --git a/components/fpspreadsheet/wikitable.pas b/components/fpspreadsheet/wikitable.pas index de5a57ed2..f63306c89 100644 --- a/components/fpspreadsheet/wikitable.pas +++ b/components/fpspreadsheet/wikitable.pas @@ -405,10 +405,15 @@ var r1, c1, r2, c2: Cardinal; isHeader: Boolean; borders: TsCellBorders; + fs: TFormatSettings; begin FWorksheet := Workbook.GetFirstWorksheet(); FWorksheet.UpdateCaches; + fs := FWorksheet.FormatSettings; + fs.DecimalSeparator := '.'; + fs.ThousandSeparator := ','; + AStrings.Add(''); // Show/hide grid lines @@ -442,7 +447,7 @@ begin for j := 0 to FWorksheet.GetLastColIndex do begin lCell := FWorksheet.FindCell(i, j); - lCurStr := FWorksheet.ReadAsUTF8Text(lCell); + lCurStr := FWorksheet.ReadAsUTF8Text(lCell, fs); // if lCurStr = '' then lCurStr := ' '; // Check for invalid characters @@ -487,9 +492,7 @@ begin if fssItalic in lFont.Style then lCurStr := '' + lCurStr + ''; if fssUnderline in lFont.Style then lCurStr := '' + lCurStr + ''; if fssStrikeout in lFont.Style then lCurStr := '' + lCurStr + ''; - end;{ else - if uffBold in lCurUsedFormatting then - lCurStr := '' + lCurStr + '';} + end; // Background color if uffBackground in lCurUsedFormatting then diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas index f68c3464e..c8ce88aa9 100755 --- a/components/fpspreadsheet/xlsbiff2.pas +++ b/components/fpspreadsheet/xlsbiff2.pas @@ -34,7 +34,7 @@ interface uses Classes, SysUtils, lconvencoding, - fpsTypes, fpsNumFormat, fpspreadsheet, fpsUtils, xlscommon; + fpsTypes, fpspreadsheet, fpsUtils, xlscommon; const BIFF2_MAX_PALETTE_SIZE = 8; @@ -42,33 +42,21 @@ const type - { TsBIFF2NumFormatList } - TsBIFF2NumFormatList = class(TsCustomNumFormatList) - protected - procedure AddBuiltinFormats; override; - public - constructor Create(AWorkbook: TsWorkbook); - procedure ConvertBeforeWriting(var AFormatString: String; - var ANumFormat: TsNumberFormat); override; - function Find(ANumFormat: TsNumberFormat; ANumFormatStr: String): Integer; override; - end; - { TsSpreadBIFF2Reader } TsSpreadBIFF2Reader = class(TsSpreadBIFFReader) private -// WorkBookEncoding: TsEncoding; FFont: TsFont; FPendingXFIndex: Word; protected - procedure CreateNumFormatList; override; + procedure AddBuiltinNumFormats; override; procedure ReadBlank(AStream: TStream); override; procedure ReadBool(AStream: TStream); override; procedure ReadColWidth(AStream: TStream); procedure ReadDefRowHeight(AStream: TStream); - procedure ReadFont(AStream: TStream); - procedure ReadFontColor(AStream: TStream); - procedure ReadFormat(AStream: TStream); override; + procedure ReadFONT(AStream: TStream); + procedure ReadFONTCOLOR(AStream: TStream); + procedure ReadFORMAT(AStream: TStream); override; procedure ReadFormula(AStream: TStream); override; procedure ReadInteger(AStream: TStream); procedure ReadIXFE(AStream: TStream); @@ -88,6 +76,7 @@ type procedure ReadFromStream(AStream: TStream); override; end; + { TsSpreadBIFF2Writer } TsSpreadBIFF2Writer = class(TsSpreadBIFFWriter) @@ -107,13 +96,12 @@ type procedure WriteFormatCount(AStream: TStream); procedure WriteIXFE(AStream: TStream; XFIndex: Word); protected - procedure CreateNumFormatList; override; - procedure ListAllNumFormats; override; + procedure AddBuiltinNumFormats; override; + procedure ListAllNumFormats(ADialect: TsNumFormatDialect); override; procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); override; procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal; const AValue: Boolean; ACell: PCell); override; -// procedure WriteCodePage(AStream: TStream; AEncoding: TsEncoding); override; procedure WriteCodePage(AStream: TStream; ACodePage: String); override; procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell); override; @@ -121,19 +109,14 @@ type const AValue: string; ACell: PCell); override; procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); override; - procedure WriteNumFormat(AStream: TStream; ANumFormatData: TsNumFormatData; - AListIndex: Integer); override; + procedure WriteNumFormat(AStream: TStream; ANumFormatStr: String; + AFormatIndex: Integer); override; procedure WriteRow(AStream: TStream; ASheet: TsWorksheet; ARowIndex, AFirstColIndex, ALastColIndex: Cardinal; ARow: PRow); override; procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell); override; function WriteRPNFunc(AStream: TStream; AIdentifier: Word): Word; override; - { - procedure WriteRPNSharedFormulaLink(AStream: TStream; ACell: PCell; - var RPNLength: Word); override; - } procedure WriteRPNTokenArraySize(AStream: TStream; ASize: Word); override; -// procedure WriteSharedFormula(AStream: TStream; ACell: PCell); override; procedure WriteStringRecord(AStream: TStream; AString: String); override; procedure WriteWindow1(AStream: TStream); override; procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet); @@ -176,7 +159,7 @@ var implementation uses - Math, fpsStrings, fpsReaderWriter, fpsNumFormatParser; + Math, fpsStrings, fpsReaderWriter; const { Excel record IDs } @@ -268,113 +251,44 @@ type end; -{ TsBIFF2NumFormatList } - -constructor TsBIFF2NumFormatList.Create(AWorkbook: TsWorkbook); -begin - inherited Create(AWorkbook); -end; - -{@@ ---------------------------------------------------------------------------- - Prepares the list of built-in number formats. They are created in the default - dialect for FPC, they have to be converted to Excel syntax before writing. - Note that Excel2 expects them to be localized. This is something which has to - be taken account of in ConvertBeforeWriting. --------------------------------------------------------------------------------} -procedure TsBIFF2NumFormatList.AddBuiltinFormats; +procedure InternalAddBuiltinNumFormats(AList: TStringList; + AFormatSettings: TFormatSettings; ADialect: TsNumFormatDialect); var - fs: TFormatSettings; - cs: string; + fs: TFormatSettings absolute AFormatSettings; + cs: String; begin - fs := FWorkbook.FormatSettings; cs := fs.CurrencyString; - AddFormat( 0, nfGeneral, ''); - AddFormat( 1, nfFixed, '0'); - AddFormat( 2, nfFixed, '0.00'); - AddFormat( 3, nfFixedTh, '#,##0'); - AddFormat( 4, nfFixedTh, '#,##0.00'); - AddFormat( 5, nfCurrency, Format('"%s"#,##0;("%s"#,##0)', [cs, cs])); - AddFormat( 6, nfCurrencyRed, Format('"%s"#,##0;[Red]("%s"#,##0)', [cs, cs])); - AddFormat( 7, nfCurrency, Format('"%s"#,##0.00;("%s"#,##0.00)', [cs, cs])); - AddFormat( 8, nfCurrencyRed, Format('"%s"#,##0.00;[Red]("%s"#,##0.00)', [cs, cs])); - AddFormat( 9, nfPercentage, '0%'); - AddFormat(10, nfPercentage, '0.00%'); - AddFormat(11, nfExp, '0.00E+00'); - AddFormat(12, nfShortDate, fs.ShortDateFormat); - AddFormat(13, nfLongDate, fs.LongDateFormat); - AddFormat(14, nfCustom, 'd/mmm'); - AddFormat(15, nfCustom, 'mmm/yy'); - AddFormat(16, nfShortTimeAM, AddAMPM(fs.ShortTimeFormat, fs)); - AddFormat(17, nfLongTimeAM, AddAMPM(fs.LongTimeFormat, fs)); - AddFormat(18, nfShortTime, fs.ShortTimeFormat); - AddFormat(19, nfLongTime, fs.LongTimeFormat); - AddFormat(20, nfShortDateTime, fs.ShortDateFormat + ' ' + fs.ShortTimeFormat); - - FFirstNumFormatIndexInFile := 0; // BIFF2 stores built-in formats to file. - FNextNumFormatIndex := 21; // not needed - there are not user-defined formats -end; - - -procedure TsBIFF2NumFormatList.ConvertBeforeWriting(var AFormatString: String; - var ANumFormat: TsNumberFormat); -var - parser: TsNumFormatParser; -begin - Unused(ANumFormat); - - if AFormatString = '' then - AFormatString := 'General' - else begin - parser := TsNumFormatParser.Create(FWorkbook, AFormatString); - try - parser.Localize; - parser.LimitDecimals; - AFormatString := parser.FormatString[nfdExcel]; - finally - parser.Free; - end; - end; -end; - -function TsBIFF2NumFormatList.Find(ANumFormat: TsNumberFormat; - ANumFormatStr: String): Integer; -var - parser: TsNumFormatParser; - decs: Integer; - dt: string; -begin - Result := 0; - - parser := TsNumFormatParser.Create(Workbook, ANumFormatStr); - try - decs := parser.Decimals; - dt := parser.GetDateTimeCode(0); - finally - parser.Free; - end; - - case ANumFormat of - nfGeneral : exit; - nfFixed : Result := IfThen(decs = 0, 1, 2); - nfFixedTh : Result := IfThen(decs = 0, 3, 4); - nfCurrency : Result := IfThen(decs = 0, 5, 7); - nfCurrencyRed : Result := IfThen(decs = 0, 6, 8); - nfPercentage : Result := IfThen(decs = 0, 9, 10); - nfExp : Result := 11; - nfShortDate : Result := 12; - nfLongDate : Result := 13; - nfShortTimeAM : Result := 16; - nfLongTimeAM : Result := 17; - nfShortTime : Result := 18; - nfLongTime : Result := 19; - nfShortDateTime: Result := 20; - nfCustom : if dt = 'dm' then Result := 14 else - if dt = 'my' then Result := 15; + with AList do + begin + Clear; + Add(''); // 0 + Add('0'); // 1 + Add('0.00'); // 2 + Add('#,##0'); // 3 + Add('#,##0.00'); // 4 + Add(BuildCurrencyFormatString(ADialect, nfCurrency, fs, 0, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 5 + Add(BuildCurrencyFormatString(ADialect, nfCurrencyRed, fs, 0, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 6 + Add(BuildCurrencyFormatString(ADialect, nfCurrency, fs, 2, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 7 + Add(BuildCurrencyFormatString(ADialect, nfCurrencyRed, fs, 2, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 8 + Add('0%'); // 9 + Add('0.00%'); // 10 + Add('0.00E+00'); // 11 + Add(BuildDateTimeFormatString(nfShortDate, fs)); // 12 + Add(BuildDateTimeFormatString(nfLongDate, fs)); // 13 + Add(BuildDateTimeFormatString(nfDayMonth, fs)); // 14: 'd/mmm' + Add(BuildDateTimeFormatString(nfMonthYear, fs)); // 15: 'mmm/yy' + Add(BuildDateTimeFormatString(nfShortTimeAM, fs)); // 16; + Add(BuildDateTimeFormatString(nfLongTimeAM, fs)); // 17 + Add(BuildDateTimeFormatString(nfShortTime, fs)); // 18 + Add(BuildDateTimeFormatString(nfLongTime, fs)); // 19 + Add(BuildDateTimeFormatString(nfShortDateTime, fs)); // 20 end; end; -{ TsSpreadBIFF2Reader } +{------------------------------------------------------------------------------} +{ TsSpreadBIFF2Reader } +{------------------------------------------------------------------------------} constructor TsSpreadBIFF2Reader.Create(AWorkbook: TsWorkbook); begin @@ -382,14 +296,10 @@ begin FLimitations.MaxPaletteSize := BIFF2_MAX_PALETTE_SIZE; end; -{@@ ---------------------------------------------------------------------------- - Creates the correct version of the number format list. - It is for BIFF2 and BIFF3 file formats. --------------------------------------------------------------------------------} -procedure TsSpreadBIFF2Reader.CreateNumFormatList; +procedure TsSpreadBIFF2Reader.AddBuiltInNumFormats; begin - FreeAndNil(FNumFormatList); - FNumFormatList := TsBIFF2NumFormatList.Create(Workbook); + FFirstNumFormatIndexInFile := 0; + InternalAddBuiltInNumFormats(FNumFormatList, Workbook.FormatSettings, nfdDefault); end; procedure TsSpreadBIFF2Reader.ReadBlank(AStream: TStream); @@ -478,7 +388,7 @@ begin FWorksheet.DefaultRowHeight := h - ROW_HEIGHT_CORRECTION; end; -procedure TsSpreadBIFF2Reader.ReadFont(AStream: TStream); +procedure TsSpreadBIFF2Reader.ReadFONT(AStream: TStream); var lHeight: Word; lOptions: Word; @@ -509,7 +419,7 @@ begin FFontList.Add(FFont); end; -procedure TsSpreadBIFF2Reader.ReadFontColor(AStream: TStream); +procedure TsSpreadBIFF2Reader.ReadFONTCOLOR(AStream: TStream); begin FFont.Color := WordLEToN(AStream.ReadWord); end; @@ -517,7 +427,7 @@ end; {@@ ---------------------------------------------------------------------------- Reads the FORMAT record required for formatting numerical data -------------------------------------------------------------------------------} -procedure TsSpreadBIFF2Reader.ReadFormat(AStream: TStream); +procedure TsSpreadBIFF2Reader.ReadFORMAT(AStream: TStream); begin Unused(AStream); // We ignore the formats in the file, everything is known @@ -811,7 +721,8 @@ begin ACol := WordLEToN(AStream.ReadWord); { Index to XF record } - AXF := AStream.ReadByte and $3F; // to do: if AXF = $3F = 63 then there must be a IXFE record which contains the true XF index! + AXF := AStream.ReadByte and $3F; + // If AXF = $3F = 63 then there is an IXFE record containing the true XF index! if AXF = $3F then AXF := FPendingXFIndex; @@ -964,7 +875,8 @@ var rec: TBIFF2_XFRecord; fmt: TsCellFormat; b: Byte; - nfdata: TsNumFormatData; + nf: TsNumFormatParams; + nfs: String; i: Integer; fnt: TsFont; begin @@ -982,23 +894,19 @@ begin fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color); if fmt.FontIndex = -1 then fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color); - { - if fmt.FontIndex = BOLD_FONTINDEX then - Include(fmt.UsedFormattingFields, uffBold) - else - } - if fmt.FontIndex > 1 then + if fmt.FontIndex > 0 then Include(fmt.UsedFormattingFields, uffFont); // Number format index b := rec.NumFormatIndex_Flags and $3F; - i := NumFormatList.FindByIndex(b); - if i > -1 then begin - nfdata := NumFormatList.Items[i]; - fmt.NumberFormat := nfdata.NumFormat; - fmt.NumberFormatStr := nfdata.FormatString; - if nfdata.NumFormat <> nfGeneral then - Include(fmt.UsedFormattingFields, uffNumberFormat); + nfs := NumFormatList[b]; + if nfs <> '' then + begin + fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs); + nf := Workbook.GetNumberFormat(fmt.NumberFormatIndex); + fmt.NumberFormat := nf.NumFormat; + fmt.NumberFormatStr := nf.NumFormatStr[nfdDefault]; + Include(fmt.UsedFormattingFields, uffNumberFormat); end; // Horizontal alignment @@ -1046,7 +954,9 @@ begin end; -{ TsSpreadBIFF2Writer } +{------------------------------------------------------------------------------} +{ TsSpreadBIFF2Writer } +{------------------------------------------------------------------------------} constructor TsSpreadBIFF2Writer.Create(AWorkbook: TsWorkbook); begin @@ -1058,13 +968,13 @@ begin end; {@@ ---------------------------------------------------------------------------- - Creates the correct version of the number format list. - It is valid for BIFF2 and BIFF3 file formats. + Adds the built-in number formats to the NumFormatList. + Inherited method overridden for BIFF2 specialties. -------------------------------------------------------------------------------} -procedure TsSpreadBIFF2Writer.CreateNumFormatList; +procedure TsSpreadBIFF2Writer.AddBuiltInNumFormats; begin - FreeAndNil(FNumFormatList); - FNumFormatList := TsBIFF2NumFormatList.Create(Workbook); + FFirstNumFormatIndexInFile := 0; + InternalAddBuiltInNumFormats(FNumFormatList, Workbook.FormatSettings, nfdExcel); end; {@@ ---------------------------------------------------------------------------- @@ -1118,16 +1028,15 @@ begin Attrib3 := Attrib3 or $80; end; -{ Builds up the list of number formats to be written to the biff2 file. +{@@ ---------------------------------------------------------------------------- + Builds up the list of number formats to be written to the biff2 file. Unlike biff5+ no formats are added here because biff2 supports only 21 - standard formats; these formats have been added by the NumFormatList's - AddBuiltInFormats. - - NOT CLEAR IF THIS IS TRUE ???? - } - // ToDo: check if the BIFF2 format is really restricted to 21 formats. -procedure TsSpreadBIFF2Writer.ListAllNumFormats; + standard formats; these formats have been added by AddBuiltInFormats. + Nothing to do here. +-------------------------------------------------------------------------------} +procedure TsSpreadBIFF2Writer.ListAllNumFormats(ADialect: TsNumFormatDialect); begin + Unused(ADialect); // Nothing to do here. end; @@ -1325,7 +1234,7 @@ begin WriteFonts(AStream); WriteCodePage(AStream, FCodePage); WriteFormatCount(AStream); - WriteNumFormats(AStream); + WriteNumFormats(AStream, nfdExcel); WriteXFRecords(AStream); WriteColWidths(AStream); WriteDimensions(AStream, FWorksheet); @@ -1425,6 +1334,7 @@ var rec: TBIFF2_XFRecord; b: Byte; j: Integer; + nfParams: TsNumFormatParams; begin Unused(XFType_Prot); @@ -1436,11 +1346,6 @@ begin rec.FontIndex := 0; if (AFormatRecord <> nil) then begin - { - if (uffBold in AFormatRecord^.UsedFormattingFields) then - rec.FontIndex := BOLD_FONTINDEX - else - } if (uffFont in AFormatRecord^.UsedFormattingFields) then begin rec.FontIndex := AFormatRecord^.FontIndex; @@ -1460,19 +1365,57 @@ begin rec.NumFormatIndex_Flags := 0; if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields) then begin - // The number formats in the FormatList are still in fpc dialect - // They will be converted to Excel syntax immediately before writing. - j := NumFormatList.Find(AFormatRecord^.NumberFormat, AFormatRecord^.NumberFormatStr); - if j > -1 then - rec.NumFormatIndex_Flags := NumFormatList[j].Index; - + nfParams := Workbook.GetNumberFormat(AFormatRecord^.NumberFormatIndex); + if nfParams <> nil then + case nfParams.NumFormat of + nfGeneral: + j := 0; + nfFixed: + j := IfThen(nfParams.Sections[0].Decimals = 0, 1, 2); + nfFixedTh: + j := IfThen(nfParams.Sections[0].Decimals = 0, 3, 4); + nfCurrency: + j := IfThen(nfParams.Sections[0].Decimals = 0, 5, 7); + nfCurrencyRed: + j := IfThen(nfParams.Sections[0].Decimals = 0, 6, 8); + nfPercentage: + j := IfThen(nfParams.Sections[0].Decimals = 0, 9, 10); + nfExp: + j := 11; + nfShortDate: + j := 12; + nfLongDate: + j := 13; + nfDayMonth: + j := 14; + nfMonthYear: + j := 15; + nfShortTimeAM: + j := 16; + nfLongTimeAM: + j := 17; + nfShortTime: + j := 18; + nfLongTime: + j := 19; + nfShortDateTime: + j := 20; + // Not available in BIFF2 + nfFraction: + j := 0; + nfTimeInterval: + j := 19; + nfCustom: + j := 0; + end; + rec.NumFormatIndex_Flags := j; // Cell flags not used, so far... end; {Horizontal alignment, border style, and background Bit Mask Contents --- ---- ------------------------------------------------ - 2-0 $07 XF_HOR_ALIGN – Horizontal alignment (0=General, 1=Left, 2=Centred, 3=Right) + 2-0 $07 XF_HOR_ALIGN – Horizontal alignment (0=General, 1=Left, 2=Centered, 3=Right) 3 $08 1 = Cell has left black border 4 $10 1 = Cell has right black border 5 $20 1 = Cell has top black border @@ -1592,7 +1535,7 @@ end; Writes an Excel 2 FORMAT record which describes formatting of numerical data. -------------------------------------------------------------------------------} procedure TsSpreadBiff2Writer.WriteNumFormat(AStream: TStream; - ANumFormatData: TsNumFormatData; AListIndex: Integer); + ANumFormatStr: String; AFormatIndex: Integer); type TNumFormatRecord = packed record RecordID: Word; @@ -1605,9 +1548,12 @@ var rec: TNumFormatRecord; buf: array of byte; begin - Unused(ANumFormatData); + Unused(ANumFormatStr); - s := ConvertEncoding(NumFormatList.FormatStringForWriting(AListIndex), encodingUTF8, FCodePage); + if (AFormatIndex = 0) then + s := 'General' + else + s := ConvertEncoding(NumFormatList[AFormatIndex], encodingUTF8, FCodePage); len := Length(s); { BIFF record header } diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas index e8cbc02cc..3bf5e86e2 100755 --- a/components/fpspreadsheet/xlsbiff5.pas +++ b/components/fpspreadsheet/xlsbiff5.pas @@ -59,7 +59,7 @@ interface uses Classes, SysUtils, fpcanvas, lconvencoding, - fpsTypes, fpsNumFormat, fpspreadsheet, + fpsTypes, fpspreadsheet, xlscommon, {$ifdef USE_NEW_OLE} fpolebasic, @@ -79,9 +79,9 @@ type protected { Record writing methods } procedure ReadBoundsheet(AStream: TStream); - procedure ReadFont(const AStream: TStream); - procedure ReadFormat(AStream: TStream); override; - procedure ReadLabel(AStream: TStream); override; + procedure ReadFONT(const AStream: TStream); + procedure ReadFORMAT(AStream: TStream); override; + procedure ReadLABEL(AStream: TStream); override; procedure ReadWorkbookGlobals(AStream: TStream); procedure ReadWorksheet(AStream: TStream); procedure ReadRichString(AStream: TStream); @@ -108,8 +108,8 @@ type procedure WriteIndex(AStream: TStream); procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; const AValue: string; ACell: PCell); override; - procedure WriteNumFormat(AStream: TStream; ANumFormatData: TsNumFormatData; - AListIndex: Integer); override; + procedure WriteNumFormat(AStream: TStream; ANumFormatStr: String; + ANumFormatIndex: Integer); override; procedure WriteStringRecord(AStream: TStream; AString: String); override; procedure WriteStyle(AStream: TStream); procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet); @@ -594,9 +594,10 @@ procedure TsSpreadBIFF5Reader.ReadXF(AStream: TStream); var rec: TBIFF5_XFRecord; fmt: TsCellFormat; - nfidx: Integer; +// nfidx: Integer; i: Integer; - nfdata: TsNumFormatData; + nfparams: TsNumFormatParams; + nfs: String; b: Byte; dw: DWord; fill: Word; @@ -621,6 +622,30 @@ begin Include(fmt.UsedFormattingFields, uffFont); // Number format index + if rec.NumFormatIndex <> 0 then begin + nfs := NumFormatList[rec.NumFormatIndex]; + // "General" (NumFormatIndex = 0) not stored in workbook's NumFormatList + if (rec.NumFormatIndex > 0) and not SameText(nfs, 'General') then + begin + fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs); + nfParams := Workbook.GetNumberFormat(fmt.NumberFormatIndex); + fmt.NumberFormat := nfParams.NumFormat; + fmt.NumberFormatStr := nfs; + Include(fmt.UsedFormattingFields, uffNumberFormat); + end; + end; +{ + // Number format index + nfparams := Workbook.GetNumberFormat(rec.NumFormatIndex); + nfs := nfParams.NumFormatStr[nfdDefault]; + if nfs <> '' then begin + fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs); + fmt.NumberFormat := nfParams.NumFormat; + fmt.NumberFormatStr := nfs; + Include(fmt.UsedFormattingFields, uffNumberFormat); + end; + } + { nfidx := WordLEToN(rec.NumFormatIndex); i := NumFormatList.FindByIndex(nfidx); if i > -1 then begin @@ -630,7 +655,7 @@ begin if nfdata.NumFormat <> nfGeneral then Include(fmt.UsedFormattingFields, uffNumberFormat); end; - + } // Horizontal text alignment b := rec.Align_TextBreak AND MASK_XF_HOR_ALIGN; if (b <= ord(High(TsHorAlignment))) then @@ -848,6 +873,7 @@ var len: byte; fmtIndex: Integer; fmtString: AnsiString; + nfs: String; begin // Record FORMAT, BIFF 8 (5.49): // Offset Size Contents @@ -863,9 +889,10 @@ begin SetLength(fmtString, len); AStream.ReadBuffer(fmtString[1], len); - // Add to the list -// NumFormatList.AnalyzeAndAdd(fmtIndex, AnsiToUTF8(fmtString)); - NumFormatList.AnalyzeAndAdd(fmtIndex, ConvertEncoding(fmtString, FCodePage, encodingUTF8)); + // Add to the list at the specified index. If necessary insert empty strings + nfs := ConvertEncoding(fmtString, FCodePage, encodingUTF8); + while NumFormatList.Count <= fmtIndex do NumFormatList.Add(''); + NumFormatList[fmtIndex] := nfs; end; procedure TsSpreadBIFF5Reader.ReadLabel(AStream: TStream); @@ -977,7 +1004,7 @@ begin WriteCodepage(AStream, FCodePage); WriteWindow1(AStream); WriteFonts(AStream); - WriteNumFormats(AStream); + WriteNumFormats(AStream, nfdExcel); WritePalette(AStream); WriteXFRecords(AStream); WriteStyle(AStream); @@ -1218,7 +1245,7 @@ end; data. -------------------------------------------------------------------------------} procedure TsSpreadBiff5Writer.WriteNumFormat(AStream: TStream; - ANumFormatData: TsNumFormatData; AListIndex: Integer); + ANumFormatStr: String; ANumFormatIndex: Integer); type TNumFormatRecord = packed record RecordID: Word; @@ -1228,16 +1255,13 @@ type end; var len: Integer; - fmtStr: String; + //fmtStr: String; ansiFmtStr: ansiString; rec: TNumFormatRecord; buf: array of byte; begin - if (ANumFormatData = nil) or (ANumFormatData.FormatString = '') then - exit; - - fmtStr := NumFormatList.FormatStringForWriting(AListIndex); - ansiFmtStr := ConvertEncoding(fmtStr, encodingUTF8, FCodePage); + //fmtStr := NumFormatList.FormatStringForWriting(AListIndex); + ansiFmtStr := ConvertEncoding(ANumFormatStr, encodingUTF8, FCodePage); len := Length(ansiFmtStr); { BIFF record header } @@ -1245,7 +1269,7 @@ begin rec.RecordSize := WordToLE(2 + 1 + len * SizeOf(AnsiChar)); { Format index } - rec.FormatIndex := WordToLE(ANumFormatData.Index); + rec.FormatIndex := WordToLE(ANumFormatIndex); { Format string } { Length in 1 byte } @@ -1450,6 +1474,8 @@ var j: Integer; b: Byte; dw1, dw2: DWord; + nfParams: TsNumFormatParams; + nfs: String; begin { BIFF record header } rec.RecordID := WordToLE(INT_EXCEL_ID_XF); @@ -1467,9 +1493,16 @@ begin rec.FontIndex := WordToLE(rec.FontIndex); { Index to number format } - rec.NumFormatIndex := 0; + j := 0; if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields) then begin + nfParams := Workbook.GetNumberFormat(AFormatRecord^.NumberFormatIndex); + nfs := nfParams.NumFormatStr[nfdExcel]; + j := NumFormatList.IndexOf(nfs); + if j = -1 then j := 0; + end; + rec.NumFormatIndex := WordToLE(j); +{ // The number formats in the FormatList are still in fpc dialect // They will be converted to Excel syntax immediately before writing. j := NumFormatList.Find(AFormatRecord^.NumberFormat, AFormatRecord^.NumberFormatStr); @@ -1477,7 +1510,7 @@ begin rec.NumFormatIndex := NumFormatList[j].Index; end; rec.NumFormatIndex := WordToLE(rec.NumFormatIndex); - + } { XF type, cell protection and parent style XF } rec.XFType_Prot_ParentXF := XFType_Prot and MASK_XF_TYPE_PROT; if XFType_Prot and MASK_XF_TYPE_PROT_STYLE_XF <> 0 then diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index 417032188..6c373b9f3 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -56,7 +56,7 @@ interface uses Classes, SysUtils, fpcanvas, DateUtils, contnrs, lazutf8, - fpstypes, fpsnumformat, fpspreadsheet, xlscommon, + fpstypes, fpspreadsheet, xlscommon, {$ifdef USE_NEW_OLE} fpolebasic, {$else} @@ -143,8 +143,8 @@ type procedure WriteMSODrawing2_Data(AStream: TStream; AComment: PsComment; AShapeID: Word); procedure WriteMSODrawing3(AStream: TStream); procedure WriteNOTE(AStream: TStream; AComment: PsComment; AObjID: Word); - procedure WriteNumFormat(AStream: TStream; AFormatData: TsNumFormatData; - AListIndex: Integer); override; + procedure WriteNumFormat(AStream: TStream; ANumFormatStr: String; + ANumFormatIndex: Integer); override; procedure WriteOBJ(AStream: TStream; AObjID: Word); function WriteRPNCellAddress(AStream: TStream; ARow, ACol: Cardinal; AFlags: TsRelFlags): word; override; @@ -940,9 +940,9 @@ begin if (c and MASK_EXCEL_RELATIVE_ROW <> 0) then Include(AFlags, rfRelRow); end; -{ Read the difference between cell row and column indexed of a cell and a reference - cell. - Overriding the implementation in xlscommon. } +{ Reads the difference between cell row and column indexed of a cell and + a reference cell. + Overrides the implementation in xlscommon. } procedure TsSpreadBIFF8Reader.ReadRPNCellAddressOffset(AStream: TStream; out ARowOffset, AColOffset: Integer; out AFlags: TsRelFlags); var @@ -1185,8 +1185,8 @@ var dw: DWord; fill: Integer; fs: TsFillStyle; - nfidx: Integer; - nfdata: TsNumFormatData; + nfs: String; + nfParams: TsNumFormatParams; i: Integer; fnt: TsFont; begin @@ -1208,14 +1208,20 @@ begin Include(fmt.UsedFormattingFields, uffFont); // Number format index - nfidx := WordLEToN(rec.NumFormatIndex); - i := NumFormatList.FindByIndex(nfidx); - if i > -1 then begin - nfdata := NumFormatList.Items[i]; - fmt.NumberFormat := nfdata.NumFormat; - fmt.NumberFormatStr := nfdata.FormatString; - if nfdata.NumFormat <> nfGeneral then - Include(fmt.UsedFormattingFields, uffNumberFormat); + if rec.NumFormatIndex <> 0 then begin + nfs := NumFormatList[rec.NumFormatIndex]; + // "General" (NumFormatIndex = 0) not stored in workbook's NumFormatList + if (rec.NumFormatIndex > 0) and not SameText(nfs, 'General') then + begin + fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs); + nfParams := Workbook.GetNumberFormat(fmt.NumberFormatIndex); + if nfParams <> nil then + begin + fmt.NumberFormat := nfParams.NumFormat; + fmt.NumberFormatStr := nfs; + Include(fmt.UsedFormattingFields, uffNumberFormat); + end; + end; end; // Horizontal text alignment @@ -1398,7 +1404,11 @@ begin FFontList.Add(font); end; -// Read the (number) FORMAT record for formatting numerical data +{@@ ---------------------------------------------------------------------------- + Reads the (number) FORMAT record for formatting numerical data and stores the + format strings in an internal stringlist. The strings are put at the index + specified by the FORMAT record. +-------------------------------------------------------------------------------} procedure TsSpreadBIFF8Reader.ReadFORMAT(AStream: TStream); var fmtString: String; @@ -1410,12 +1420,15 @@ begin // 2 var Number format string (Unicode string, 16-bit string length) // From BIFF5 on: indexes 0..163 are built in fmtIndex := WordLEtoN(AStream.ReadWord); + if fmtIndex = 0 then // "General" already in list + exit; // 2 var. Number format string (Unicode string, 16-bit string length, ➜2.5.3) fmtString := UTF8Encode(ReadWideString(AStream, False)); - // Analyze the format string and add format to the list - NumFormatList.AnalyzeAndAdd(fmtIndex, fmtString); + // Add to the list at the specified index. If necessary insert empty strings + while NumFormatList.Count <= fmtIndex do NumFormatList.Add(''); + NumFormatList[fmtIndex] := fmtString; end; {@@ ---------------------------------------------------------------------------- @@ -1585,16 +1598,6 @@ begin { Add tooltip to hyperlinks } for hyperlink in FWorksheet.Hyperlinks.GetRangeEnumerator(row1, col1, row2, col2) do hyperlink^.ToolTip := txt; - - { - for row := row1 to row2 do - for col := col1 to col2 do - begin - hyperlink := PsHyperlink(FWorksheet.Hyperlinks.Find(row, col)); - if hyperlink <> nil then - hyperlink^.ToolTip := txt; - end; - } end; @@ -1646,15 +1649,12 @@ begin end; end; -{******************************************************************* -* TsSpreadBIFF8Writer.WriteToStream () -* -* DESCRIPTION: Writes an Excel BIFF8 record structure -* -* Be careful as this method doesn't write the OLE -* part of the document, just the BIFF records -* -*******************************************************************} +{@@ ---------------------------------------------------------------------------- + Writes an Excel BIFF8 record structure to a stream + + Be careful as this method doesn't write the OLE part of the document, + just the BIFF records +-------------------------------------------------------------------------------} procedure TsSpreadBIFF8Writer.WriteToStream(AStream: TStream); const isBIFF8 = true; @@ -1669,7 +1669,7 @@ begin WriteCodePage(AStream, 'ucs2le'); // = utf8 WriteWindow1(AStream); WriteFonts(AStream); - WriteNumFormats(AStream); + WriteNumFormats(AStream, nfdExcel); WritePalette(AStream); WriteXFRecords(AStream); WriteStyle(AStream); @@ -1724,15 +1724,11 @@ begin SetLength(Boundsheets, 0); end; +{@@ ---------------------------------------------------------------------------- + Writes an Excel 8 BOF record -{******************************************************************* -* TsSpreadBIFF8Writer.WriteBOF () -* -* DESCRIPTION: Writes an Excel 8 BOF record -* -* This must be the first record on an Excel 8 stream -* -*******************************************************************} + This must be the first record on an Excel 8 stream +-------------------------------------------------------------------------------} procedure TsSpreadBIFF8Writer.WriteBOF(AStream: TStream; ADataType: Word); begin { BIFF Record header } @@ -1955,13 +1951,9 @@ begin AStream.WriteBuffer(WideStringToLE(WideFontName)[1], Len * Sizeof(WideChar)); end; -{******************************************************************* -* TsSpreadBIFF8Writer.WriteFonts () -* -* DESCRIPTION: Writes the Excel 8 FONT records needed for the -* used fonts in the workbook. -* -*******************************************************************} +{@@ ---------------------------------------------------------------------------- + Writes the Excel 8 FONT records needed for the fonts used in the workbook. +-------------------------------------------------------------------------------} procedure TsSpreadBiff8Writer.WriteFonts(AStream: TStream); var i: Integer; @@ -2035,9 +2027,11 @@ begin end; end; -{ Write the MSODRAWING record which occurs before the OBJ record. - Do not use for the very first OBJ record where the record must be - WriteMSODrawing1 + WriteMSODrawing2_Data} +{@@ ---------------------------------------------------------------------------- + Writes the MSODRAWING record which occurs before the OBJ record. + Not to be used for the very first OBJ record where the record must be + WriteMSODrawing1 + WriteMSODrawing2_Data +-------------------------------------------------------------------------------} procedure TsSpreadBiff8Writer.WriteMSODrawing2(AStream: TStream; AComment: PsComment; AObjID: Word); var @@ -2107,7 +2101,9 @@ begin end; end; -{ Writes the MSODRAWING record which must occur immediately before a TXO record } +{@@ ---------------------------------------------------------------------------- + Writes the MSODRAWING record which must occur immediately before a TXO record +-------------------------------------------------------------------------------} procedure TsSpreadBiff8Writer.WriteMSODRAWING3(AStream: TStream); begin { BIFF Header } @@ -2117,7 +2113,9 @@ begin WriteMSOClientTextBoxRecord(AStream); end; -{ Writes a NOTE record for a comment attached to a cell } +{@@ ---------------------------------------------------------------------------- + Writes a NOTE record for a comment attached to a cell +-------------------------------------------------------------------------------} procedure TsSpreadBiff8Writer.WriteNOTE(AStream: TStream; AComment: PsComment; AObjID: Word); const @@ -2143,7 +2141,7 @@ begin end; procedure TsSpreadBiff8Writer.WriteNumFormat(AStream: TStream; - AFormatData: TsNumFormatData; AListIndex: Integer); + ANumFormatStr: String; ANumFormatIndex: Integer); type TNumFormatRecord = packed record RecordID: Word; @@ -2154,16 +2152,11 @@ type end; var len: Integer; - s: String; ws: widestring; rec: TNumFormatRecord; buf: array of byte; begin - if (AFormatData = nil) or (AFormatData.FormatString = '') then - exit; - - s := NumFormatList.FormatStringForWriting(AListIndex); - ws := UTF8Decode(s); + ws := UTF8Decode(ANumFormatStr); len := Length(ws); { BIFF record header } @@ -2171,7 +2164,7 @@ begin rec.RecordSize := WordToLE(2 + 2 + 1 + len * SizeOf(WideChar)); { Format index } - rec.FormatIndex := WordToLE(AFormatData.Index); + rec.FormatIndex := WordToLE(ANumFormatIndex); { Format string } { - length of string = 16 bits } @@ -2190,7 +2183,9 @@ begin SetLength(buf, 0); end; -{ Writes an OBJ record - belongs to the record required for cell comments } +{@@ ---------------------------------------------------------------------------- + Writes an OBJ record - belongs to the records required for cell comments +-------------------------------------------------------------------------------} procedure TsSpreadBIFF8Writer.WriteOBJ(AStream: TStream; AObjID: Word); var guid: TGuid; @@ -2219,8 +2214,10 @@ begin AStream.WriteWord(0); // Size of subrecord: 0 bytes end; -{ Writes the address of a cell as used in an RPN formula and returns the - number of bytes written. } +{@@ ---------------------------------------------------------------------------- + Writes the address of a cell as used in an RPN formula and returns the + number of bytes written. +-------------------------------------------------------------------------------} function TsSpreadBIFF8Writer.WriteRPNCellAddress(AStream: TStream; ARow, ACol: Cardinal; AFlags: TsRelFlags): Word; var @@ -2234,8 +2231,10 @@ begin Result := 4; end; -{ Writes row and column offset (unsigned integers!) - Valid for BIFF2-BIFF5. } +{@@ ---------------------------------------------------------------------------- + Writes row and column offset needed in RPN formulas (unsigned integers!) + Valid for BIFF2-BIFF5. +-------------------------------------------------------------------------------} function TsSpreadBIFF8Writer.WriteRPNCellOffset(AStream: TStream; ARowOffset, AColOffset: Integer; AFlags: TsRelFlags): Word; var @@ -2255,8 +2254,10 @@ begin Result := 4; end; -{ Writes the address of a cell range as used in an RPN formula and returns the - count of bytes written. } +{@@ ---------------------------------------------------------------------------- + Writes the address of a cell range as used in an RPN formula and returns the + count of bytes written. +-------------------------------------------------------------------------------} function TsSpreadBIFF8Writer.WriteRPNCellRangeAddress(AStream: TStream; ARow1, ACol1, ARow2, ACol2: Cardinal; AFlags: TsRelFlags): Word; var @@ -2278,9 +2279,11 @@ begin Result := 8; end; -{ Helper function for writing a string with 8-bit length. Overridden version +{@@ ---------------------------------------------------------------------------- + Helper function for writing a string with 8-bit length. Overridden version for BIFF8. Called for writing rpn formula string tokens. - Returns the count of bytes written} + Returns the count of bytes written. +-------------------------------------------------------------------------------} function TsSpreadBIFF8Writer.WriteString_8BitLen(AStream: TStream; AString: String): Integer; var @@ -2803,6 +2806,8 @@ var b: Byte; dw1, dw2: DWord; w3: Word; + nfParams: TsNumFormatParams; + nfs: String; begin { BIFF record header } rec.RecordID := WordToLE(INT_EXCEL_ID_XF); @@ -2820,16 +2825,18 @@ begin rec.FontIndex := WordToLE(rec.FontIndex); { Index to number format } - rec.NumFormatIndex := 0; + j := 0; if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields) then begin - // The number formats in the FormatList are still in fpc dialect - // They will be converted to Excel syntax immediately before writing. - j := NumFormatList.Find(AFormatRecord^.NumberFormat, AFormatRecord^.NumberFormatStr); - if j > -1 then - rec.NumFormatIndex := NumFormatList[j].Index; + nfParams := Workbook.GetNumberFormat(AFormatRecord^.NumberFormatIndex); + if nfParams <> nil then + begin + nfs := nfParams.NumFormatStr[nfdExcel]; + j := NumFormatList.IndexOf(nfs); + if j = -1 then j := 0; + end; end; - rec.NumFormatIndex := WordToLE(rec.NumFormatIndex); + rec.NumFormatIndex := WordToLE(j); { XF type, cell protection and parent style XF } rec.XFType_Prot_ParentXF := XFType_Prot and MASK_XF_TYPE_PROT; @@ -2944,16 +2951,12 @@ begin end; -{@@ ---------------------------------------------------------------------------- - Initialization section - - Registers this reader / writer on fpSpreadsheet - Converts the palette to litte-endian --------------------------------------------------------------------------------} - initialization + // Registers this reader / writer in fpSpreadsheet RegisterSpreadFormat(TsSpreadBIFF8Reader, TsSpreadBIFF8Writer, sfExcel8); + + // Converts the palette to litte-endian MakeLEPalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8)); end. diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index 51a22a971..b1ba69d1c 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -11,7 +11,8 @@ interface uses Classes, SysUtils, DateUtils, lconvencoding, - fpsTypes, fpSpreadsheet, fpsUtils, fpsNumFormat, fpsReaderWriter; + fpsTypes, fpSpreadsheet, fpsUtils, fpsNumFormatParser, + fpsReaderWriter; const { RECORD IDs which didn't change across versions 2-8 } @@ -237,15 +238,6 @@ type RecordSize: Word; end; - { TsBIFFNumFormatList } - TsBIFFNumFormatList = class(TsCustomNumFormatList) - protected - procedure AddBuiltinFormats; override; - public - procedure ConvertBeforeWriting(var AFormatString: String; - var ANumFormat: TsNumberFormat); override; - end; - { TsSpreadBIFFReader } TsSpreadBIFFReader = class(TsCustomSpreadReader) protected @@ -256,8 +248,9 @@ type FIncompleteCell: PCell; FIncompleteNote: String; FIncompleteNoteLength: Word; + FFirstNumFormatIndexInFile: Integer; + procedure AddBuiltinNumFormats; override; procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); virtual; //overload; - procedure CreateNumFormatList; override; // Extracts a number out of an RK value function DecodeRKValue(const ARK: DWORD): Double; // Returns the numberformat for a given XF record @@ -336,14 +329,11 @@ type protected FDateMode: TDateMode; FCodePage: String; // in a format prepared for lconvencoding.ConvertEncoding -// FLastRow: Cardinal; -// FLastCol: Cardinal; - procedure CreateNumFormatList; override; + FFirstNumFormatIndexInFile: Integer; + procedure AddBuiltinNumFormats; override; function FindXFIndex(ACell: PCell): Integer; virtual; function FixColor(AColor: TsColor): TsColor; override; -// procedure GetLastRowCallback(ACell: PCell; AStream: TStream); function GetLastRowIndex(AWorksheet: TsWorksheet): Integer; -// procedure GetLastColCallback(ACell: PCell; AStream: TStream); function GetLastColIndex(AWorksheet: TsWorksheet): Word; // Helper function for writing the BIFF header @@ -376,10 +366,10 @@ type procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); override; // Writes out a FORMAT record - procedure WriteNumFormat(AStream: TStream; ANumFormatData: TsNumFormatData; - AListIndex: Integer); virtual; + procedure WriteNumFormat(AStream: TStream; ANumFormatStr: String; + ANumFormatIndex: Integer); virtual; // Writes out all FORMAT records - procedure WriteNumFormats(AStream: TStream); + procedure WriteNumFormats(AStream: TStream; ADialect: TsNumFormatDialect); // Writes out a floating point NUMBER record procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: Double; ACell: PCell); override; @@ -438,12 +428,16 @@ type constructor Create(AWorkbook: TsWorkbook); override; end; +procedure AddBuiltinBiffFormats(AList: TStringList; + AFormatSettings: TFormatSettings; ALastIndex: Integer; + ADialect: TsNumFormatDialect); + implementation uses AVL_Tree, Math, Variants, - {%H-}fpspatches, fpsStrings, xlsConst, fpsNumFormatParser, fpsrpn, fpsExprParser; + {%H-}fpspatches, fpsStrings, xlsConst, fpsrpn, fpsExprParser; const { Helper table for rpn formulas: @@ -528,20 +522,20 @@ begin else begin case ADateMode of - dm1900: - begin - // Check for Lotus 1-2-3 bug with 1900 leap year - if AExcelDateNum=61.0 then - // 29 feb does not exist, change to 28 - // Spell out that we remove a day for ehm "clarity". - result:=61.0-1.0+DATEMODE_1900_BASE-1.0 + dm1900: + begin + // Check for Lotus 1-2-3 bug with 1900 leap year + if AExcelDateNum=61.0 then + // 29 feb does not exist, change to 28 + // Spell out that we remove a day for ehm "clarity". + result := 61.0 - 1.0 + DATEMODE_1900_BASE - 1.0 + else + result := AExcelDateNum + DATEMODE_1900_BASE - 1.0; + end; + dm1904: + result := AExcelDateNum + DATEMODE_1904_BASE; else - result:=AExcelDateNum+DATEMODE_1900_BASE-1.0; - end; - dm1904: - result:=AExcelDateNum+DATEMODE_1904_BASE; - else - raise Exception.CreateFmt('ConvertExcelDateTimeToDateTime: unknown datemode %d. Please correct fpspreadsheet source code. ', [ADateMode]); + raise Exception.CreateFmt('[ConvertExcelDateTimeToDateTime] Unknown datemode %d. Please correct fpspreadsheet source code. ', [ADateMode]); end; end; end; @@ -594,82 +588,60 @@ begin end; -{------------------------------------------------------------------------------} -{ TsBIFFNumFormatList } -{------------------------------------------------------------------------------} - {@@ ---------------------------------------------------------------------------- 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 are specified here in fpc dialect. + number format that Excel used. -------------------------------------------------------------------------------} -procedure TsBIFFNumFormatList.AddBuiltinFormats; +procedure AddBuiltinBiffFormats(AList: TStringList; + AFormatSettings: TFormatSettings; ALastIndex: Integer; + ADialect: TsNumFormatDialect); var - fs: TFormatSettings; + fs: TFormatSettings absolute AFormatSettings; cs: String; + i: Integer; begin - fs := Workbook.FormatSettings; - cs := Workbook.FormatSettings.CurrencyString; - - AddFormat( 0, nfGeneral, ''); - AddFormat( 1, nfFixed, '0'); - AddFormat( 2, nfFixed, '0.00'); - AddFormat( 3, nfFixedTh, '#,##0'); - AddFormat( 4, nfFixedTh, '#,##0.00'); - AddFormat( 5, nfCurrency, '"'+cs+'"#,##0;("'+cs+'"#,##0)'); - AddFormat( 6, nfCurrencyRed, '"'+cs+'"#,##0;[Red]("'+cs+'"#,##0)'); - AddFormat( 7, nfCurrency, '"'+cs+'"#,##0.00;("'+cs+'"#,##0.00)'); - AddFormat( 8, nfCurrencyRed, '"'+cs+'"#,##0.00;[Red]("'+cs+'"#,##0.00)'); - AddFormat( 9, nfPercentage, '0%'); - AddFormat(10, nfPercentage, '0.00%'); - AddFormat(11, nfExp, '0.00E+00'); - AddFormat(12, nfFraction, '# ?/?'); - AddFormat(13, nfFraction, '# ??/??'); - AddFormat(14, nfShortDate, fs.ShortDateFormat); // 'M/D/YY' - AddFormat(15, nfLongDate, fs.LongDateFormat); // 'D-MMM-YY' - AddFormat(16, nfCustom, 'd/mmm'); // 'D-MMM' - AddFormat(17, nfCustom, 'mmm/yy'); // 'MMM-YY' - AddFormat(18, nfShortTimeAM, AddAMPM(fs.ShortTimeFormat, fs)); // 'h:mm AM/PM' - AddFormat(19, nfLongTimeAM, AddAMPM(fs.LongTimeFormat, fs)); // 'h:mm:ss AM/PM' - AddFormat(20, nfShortTime, fs.ShortTimeFormat); // 'h:mm' - AddFormat(21, nfLongTime, fs.LongTimeFormat); // 'h:mm:ss' - AddFormat(22, nfShortDateTime, fs.ShortDateFormat + ' ' + fs.ShortTimeFormat); // 'M/D/YY h:mm' (localized) - // 23..36 not supported - AddFormat(37, nfCurrency, '_(#,##0_);(#,##0)'); - AddFormat(38, nfCurrencyRed, '_(#,##0_);[Red](#,##0)'); - AddFormat(39, nfCurrency, '_(#,##0.00_);(#,##0.00)'); - AddFormat(40, nfCurrencyRed, '_(#,##0.00_);[Red](#,##0.00)'); - AddFormat(41, nfCustom, '_("'+cs+'"* #,##0_);_("'+cs+'"* (#,##0);_("'+cs+'"* "-"_);_(@_)'); - AddFormat(42, nfCustom, '_(* #,##0_);_(* (#,##0);_(* "-"_);_(@_)'); - AddFormat(43, nfCustom, '_("'+cs+'"* #,##0.00_);_("'+cs+'"* (#,##0.00);_("'+cs+'"* "-"??_);_(@_)'); - AddFormat(44, nfCustom, '_(* #,##0.00_);_(* (#,##0.00);_(* "-"??_);_(@_)'); - AddFormat(45, nfCustom, 'nn:ss'); - AddFormat(46, nfTimeInterval, '[h]:nn:ss'); - AddFormat(47, nfCustom, 'nn:ss.z'); - AddFormat(48, nfCustom, '##0.0E+00'); - // 49 ("Text") not supported - - // All indexes from 0 to 163 are reserved for built-in formats. - // The first user-defined format starts at 164. - FFirstNumFormatIndexInFile := 164; - FNextNumFormatIndex := 164; -end; - -procedure TsBIFFNumFormatList.ConvertBeforeWriting(var AFormatString: String; - var ANumFormat: TsNumberFormat); -var - parser: TsNumFormatParser; -begin - parser := TsNumFormatParser.Create(Workbook, AFormatString, ANumFormat); - try - if parser.Status = psOK then begin - // For writing, we have to convert the fpc format string to Excel dialect - AFormatString := parser.FormatString[nfdExcel]; - ANumFormat := parser.NumFormat; - end; - finally - parser.Free; - end; + cs := fs.CurrencyString; + AList.Clear; + AList.Add(''); // 0 + AList.Add('0'); // 1 + AList.Add('0.00'); // 2 + AList.Add('#,##0'); // 3 + AList.Add('#,##0.00'); // 4 + AList.Add(BuildCurrencyFormatString(ADialect, nfCurrency, fs, 0, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 5 + AList.Add(BuildCurrencyFormatString(ADialect, nfCurrencyRed, fs, 0, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 6 + AList.Add(BuildCurrencyFormatString(ADialect, nfCurrency, fs, 2, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 7 + AList.Add(BuildCurrencyFormatString(ADialect, nfCurrencyRed, fs, 2, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 8 + AList.Add('0%'); // 9 + AList.Add('0.00%'); // 10 + AList.Add('0.00E+00'); // 11 + AList.Add('# ?/?'); // 12 + AList.Add('# ??/??'); // 13 + AList.Add(BuildDateTimeFormatString(nfShortDate, fs)); // 14 + AList.Add(BuildDateTimeFormatString(nfLongdate, fs)); // 15 + AList.Add(BuildDateTimeFormatString(nfDayMonth, fs)); // 16: 'd/mmm' + AList.Add(BuildDateTimeFormatString(nfMonthYear, fs)); // 17: 'mmm/yy' + AList.Add(BuildDateTimeFormatString(nfShortTimeAM, fs)); // 18 + AList.Add(BuildDateTimeFormatString(nfLongTimeAM, fs)); // 19 + AList.Add(BuildDateTimeFormatString(nfShortTime, fs)); // 20 + AList.Add(BuildDateTimeFormatString(nfLongTime, fs)); // 21 + AList.Add(BuildDateTimeFormatString(nfShortDateTime, fs)); // 22 + for i:=23 to 36 do + AList.Add(''); // not supported + AList.Add('_(#,##0_);(#,##0)'); // 37 + AList.Add('_(#,##0_);[Red](#,##0)'); // 38 + AList.Add('_(#,##0.00_);(#,##0.00)'); // 39 + AList.Add('_(#,##0.00_);[Red](#,##0.00)'); // 40 + AList.Add('_("'+cs+'"* #,##0_);_("'+cs+'"* (#,##0);_("'+cs+'"* "-"_);_(@_)'); // 41 + AList.Add('_(* #,##0_);_(* (#,##0);_(* "-"_);_(@_)'); // 42 + AList.Add('_("'+cs+'"* #,##0.00_);_("'+cs+'"* (#,##0.00);_("'+cs+'"* "-"??_);_(@_)'); // 43 + AList.Add('_(* #,##0.00_);_(* (#,##0.00);_(* "-"??_);_(@_)'); // 44 + AList.Add('nn:ss'); // 45 + AList.Add('[h]:nn:ss'); // 46 + AList.Add('nn:ss.z'); // 47 + AList.Add('##0.0E+00'); // 48 + AList.Add(''); // 49: @ ("Text") not supported + for i:=50 to ALastIndex do AList.Add(''); // not supported/used end; @@ -690,6 +662,18 @@ begin FLimitations.MaxPaletteSize := 64; end; +{@@ ---------------------------------------------------------------------------- + Adds the built-in number formats to the NumFormatList. + Valid for BIFF5...BIFF8. Needs to be overridden for BIFF2. +-------------------------------------------------------------------------------} +procedure TsSpreadBIFFReader.AddBuiltinNumFormats; +begin + FFirstNumFormatIndexInFile := 164; + AddBuiltInBiffFormats( + FNumFormatList, Workbook.FormatSettings, FFirstNumFormatIndexInFile-1, nfdDefault + ); +end; + {@@ ---------------------------------------------------------------------------- Applies the XF formatting referred to by XFIndex to the specified cell -------------------------------------------------------------------------------} @@ -709,16 +693,6 @@ begin end; end; -{@@ ---------------------------------------------------------------------------- - Creates the correct version of the number format list. It is for BIFF file - formats. - Valid for BIFF5.BIFF8. Needs to be overridden for BIFF2. --------------------------------------------------------------------------------} -procedure TsSpreadBIFFReader.CreateNumFormatList; -begin - FreeAndNil(FNumFormatList); - FNumFormatList := TsBIFFNumFormatList.Create(Workbook); -end; {@@ ---------------------------------------------------------------------------- Extracts a number out of an RK value. @@ -787,7 +761,7 @@ var begin Result := true; if ANumberFormat in [ - nfShortDateTime, {nfFmtDateTime, }nfShortDate, nfLongDate, + nfShortDateTime, nfShortDate, nfLongDate, nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM] then ADateTime := ConvertExcelDateTimeToDateTime(Number, FDateMode) @@ -1078,6 +1052,7 @@ end; {@@ ---------------------------------------------------------------------------- Reads the (number) FORMAT record for formatting numerical data + To be overridden by descendants. -------------------------------------------------------------------------------} procedure TsSpreadBIFFReader.ReadFormat(AStream: TStream); begin @@ -1879,14 +1854,15 @@ begin end; {@@ ---------------------------------------------------------------------------- - Creates the correct version of the number format list. It is for BIFF file - formats. - Valid for BIFF5.BIFF8. Needs to be overridden for BIFF2. + Adds the built-in number formats to the NumFormatList. + Valid for BIFF5...BIFF8. Needs to be overridden for BIFF2. -------------------------------------------------------------------------------} -procedure TsSpreadBIFFWriter.CreateNumFormatList; +procedure TsSpreadBIFFWriter.AddBuiltinNumFormats; begin - FreeAndNil(FNumFormatList); - FNumFormatList := TsBIFFNumFormatList.Create(Workbook); + FFirstNumFormatIndexInFile := 164; + AddBuiltInBiffFormats( + FNumFormatList, Workbook.FormatSettings, FFirstNumFormatIndexInFile-1, nfdExcel + ); end; {@@ ---------------------------------------------------------------------------- @@ -1908,37 +1884,15 @@ begin end else Result := AColor; end; - (* -procedure TsSpreadBIFFWriter.GetLastRowCallback(ACell: PCell; AStream: TStream); -begin - Unused(AStream); - if ACell^.Row > FLastRow then FLastRow := ACell^.Row; -end; *) function TsSpreadBIFFWriter.GetLastRowIndex(AWorksheet: TsWorksheet): Integer; begin Result := AWorksheet.GetLastRowIndex; - { - FLastRow := 0; - IterateThroughCells(nil, AWorksheet.Cells, @GetLastRowCallback); - Result := FLastRow; - } end; - (* -procedure TsSpreadBIFFWriter.GetLastColCallback(ACell: PCell; AStream: TStream); -begin - Unused(AStream); - if ACell^.Col > FLastCol then FLastCol := ACell^.Col; -end; - *) + function TsSpreadBIFFWriter.GetLastColIndex(AWorksheet: TsWorksheet): Word; begin Result := AWorksheet.GetLastColIndex; - { - FLastCol := 0; - IterateThroughCells(nil, AWorksheet.Cells, @GetLastColCallback); - Result := FLastCol; - } end; {@@ ---------------------------------------------------------------------------- @@ -2241,15 +2195,15 @@ begin end; {@@ ---------------------------------------------------------------------------- - Writes a BIFF number format record defined in AFormatData. - AListIndex the index of the numformatdata in the numformat list - (not the FormatIndex!). + Writes a BIFF number format record defined in the specified format string + (in Excel dialect). + AFormatIndex is equal to the format index used in the Excel file. Needs to be overridden by descendants. -------------------------------------------------------------------------------} procedure TsSpreadBIFFWriter.WriteNumFormat(AStream: TStream; - ANumFormatData: TsNumFormatData; AListIndex: Integer); + ANumFormatStr: String; ANumFormatIndex: Integer); begin - Unused(AStream, ANumFormatData, AListIndex); + Unused(AStream, ANumFormatStr, ANumFormatIndex); // needs to be overridden end; @@ -2257,13 +2211,28 @@ end; Writes all number formats to the stream. Saving starts at the item with the FirstFormatIndexInFile. -------------------------------------------------------------------------------} -procedure TsSpreadBIFFWriter.WriteNumFormats(AStream: TStream); +procedure TsSpreadBIFFWriter.WriteNumFormats(AStream: TStream; + ADialect: TsNumFormatDialect); var i: Integer; - item: TsNumFormatData; + parser: TsNumFormatParser; + fmtStr: String; begin - ListAllNumFormats; - i := NumFormatList.FindByIndex(NumFormatList.FirstNumFormatIndexInFile); + ListAllNumFormats(ADialect); + for i:= FFirstNumFormatIndexInFile to NumFormatList.Count-1 do + begin + fmtStr := NumFormatList[i]; + parser := TsNumFormatParser.Create(Workbook, fmtStr); + try + fmtStr := parser.FormatString[ADialect];; + WriteNumFormat(AStream, fmtStr, i); + finally + parser.Free; + end; + end; + +{ + i := NumFormatList.FindByIndex(FFirstNumFormatIndexInFile); if i > -1 then while i < NumFormatList.Count do begin @@ -2272,6 +2241,7 @@ begin WriteNumFormat(AStream, item, i); inc(i); end; +} end; {@@ ---------------------------------------------------------------------------- diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 402bb3db9..676d18cd8 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -47,15 +47,6 @@ uses type - { TsOOXMLFormatList } - TsOOXMLNumFormatList = class(TsCustomNumFormatList) - protected - procedure AddBuiltinFormats; override; - public - procedure ConvertBeforeWriting(var AFormatString: String; - var ANumFormat: TsNumberFormat); override; - end; - { TsSpreadOOXMLReader } TsSpreadOOXMLReader = class(TsSpreadXMLReader) @@ -96,7 +87,8 @@ type procedure ReadThemeColors(ANode: TDOMNode); procedure ReadWorksheet(ANode: TDOMNode; AWorksheet: TsWorksheet); protected - procedure CreateNumFormatList; override; + FFirstNumFormatIndexInFile: Integer; + procedure AddBuiltinNumFormats; override; public constructor Create(AWorkbook: TsWorkbook); override; destructor Destroy; override; @@ -109,9 +101,7 @@ type TsSpreadOOXMLWriter = class(TsCustomSpreadWriter) private FNext_rId: Integer; - procedure WriteVmlDrawingsCallback(AComment: PsComment; - ACommentIndex: Integer; AStream: TStream); - + FFirstNumFormatIndexInFile: Integer; protected FDateMode: TDateMode; FPointSeparatorSettings: TFormatSettings; @@ -119,8 +109,7 @@ type FFillList: array of PsCellFormat; FBorderList: array of PsCellFormat; protected - { Helper routines } - procedure CreateNumFormatList; override; + procedure AddBuiltinNumFormats; override; procedure CreateStreams; procedure DestroyStreams; function FindBorderInList(AFormat: PsCellFormat): Integer; @@ -377,85 +366,9 @@ const ); - - -{ TsOOXMLNumFormatList } - -{ These are the built-in number formats as expected in the biff spreadsheet file. - Identical to BIFF8. These formats are not written to file but they are used - for lookup of the number format that Excel used. They are specified here in - fpc dialect. } -procedure TsOOXMLNumFormatList.AddBuiltinFormats; -var - fs: TFormatSettings; - cs: String; -begin - fs := Workbook.FormatSettings; - cs := AnsiToUTF8(Workbook.FormatSettings.CurrencyString); - - AddFormat( 0, nfGeneral, ''); - AddFormat( 1, nfFixed, '0'); - AddFormat( 2, nfFixed, '0.00'); - AddFormat( 3, nfFixedTh, '#,##0'); - AddFormat( 4, nfFixedTh, '#,##0.00'); - AddFormat( 5, nfCurrency, '"'+cs+'"#,##0_);("'+cs+'"#,##0)'); - AddFormat( 6, nfCurrencyRed, '"'+cs+'"#,##0_);[Red]("'+cs+'"#,##0)'); - AddFormat( 7, nfCurrency, '"'+cs+'"#,##0.00_);("'+cs+'"#,##0.00)'); - AddFormat( 8, nfCurrencyRed, '"'+cs+'"#,##0.00_);[Red]("'+cs+'"#,##0.00)'); - AddFormat( 9, nfPercentage, '0%'); - AddFormat(10, nfPercentage, '0.00%'); - AddFormat(11, nfExp, '0.00E+00'); - AddFormat(12, nfFraction, '# ?/?'); - AddFormat(13, nfFraction, '# ??/??'); - AddFormat(14, nfShortDate, fs.ShortDateFormat); // 'M/D/YY' - AddFormat(15, nfLongDate, fs.LongDateFormat); // 'D-MMM-YY' - AddFormat(16, nfCustom, 'd/mmm'); // 'D-MMM' - AddFormat(17, nfCustom, 'mmm/yy'); // 'MMM-YY' - AddFormat(18, nfShortTimeAM, AddAMPM(fs.ShortTimeFormat, fs)); // 'h:mm AM/PM' - AddFormat(19, nfLongTimeAM, AddAMPM(fs.LongTimeFormat, fs)); // 'h:mm:ss AM/PM' - AddFormat(20, nfShortTime, fs.ShortTimeFormat); // 'h:mm' - AddFormat(21, nfLongTime, fs.LongTimeFormat); // 'h:mm:ss' - AddFormat(22, nfShortDateTime, fs.ShortDateFormat + ' ' + fs.ShortTimeFormat); // 'M/D/YY h:mm' (localized) - // 23..36 not supported - AddFormat(37, nfCurrency, '_(#,##0_);(#,##0)'); - AddFormat(38, nfCurrencyRed, '_(#,##0_);[Red](#,##0)'); - AddFormat(39, nfCurrency, '_(#,##0.00_);(#,##0.00)'); - AddFormat(40, nfCurrencyRed, '_(#,##0.00_);[Red](#,##0.00)'); - AddFormat(41, nfCustom, '_("'+cs+'"* #,##0_);_("'+cs+'"* (#,##0);_("'+cs+'"* "-"_);_(@_)'); - AddFormat(42, nfCustom, '_(* #,##0_);_(* (#,##0);_(* "-"_);_(@_)'); - AddFormat(43, nfCustom, '_("'+cs+'"* #,##0.00_);_("'+cs+'"* (#,##0.00);_("'+cs+'"* "-"??_);_(@_)'); - AddFormat(44, nfCustom, '_(* #,##0.00_);_(* (#,##0.00);_(* "-"??_);_(@_)'); - AddFormat(45, nfCustom, 'nn:ss'); - AddFormat(46, nfTimeInterval, '[h]:nn:ss'); - AddFormat(47, nfCustom, 'nn:ss.z'); - AddFormat(48, nfCustom, '##0.0E+00'); - // 49 ("Text") not supported - - // All indexes from 0 to 163 are reserved for built-in formats. - // The first user-defined format starts at 164. - FFirstNumFormatIndexInFile := 164; - FNextNumFormatIndex := 164; -end; - -procedure TsOOXMLNumFormatList.ConvertBeforeWriting(var AFormatString: String; - var ANumFormat: TsNumberFormat); -var - parser: TsNumFormatParser; -begin - parser := TsNumFormatParser.Create(Workbook, AFormatString, ANumFormat); - try - if parser.Status = psOK then begin - // For writing, we have to convert the fpc format string to Excel dialect - AFormatString := parser.FormatString[nfdExcel]; - ANumFormat := parser.NumFormat; - end; - finally - parser.Free; - end; -end; - - -{ TsSpreadOOXMLReader } +{------------------------------------------------------------------------------} +{ TsSpreadOOXMLReader } +{------------------------------------------------------------------------------} constructor TsSpreadOOXMLReader.Create(AWorkbook: TsWorkbook); begin @@ -492,11 +405,22 @@ begin FSharedStrings.Free; FSharedFormulaBaseList.Free; // Don't free items, they are worksheet cells - // FCellFormatList and FFontList are destroyed by ancestor + // FCellFormatList, FNumFormatList and FFontList are destroyed by ancestor inherited Destroy; end; +{@@ ---------------------------------------------------------------------------- + Adds the built-in number formats to the NumFormatList. +-------------------------------------------------------------------------------} +procedure TsSpreadOOXMLReader.AddBuiltinNumFormats; +begin + FFirstNumFormatIndexInFile := 164; + AddBuiltInBiffFormats( + FNumFormatList, Workbook.FormatSettings, FFirstNumFormatIndexInFile-1, nfdDefault + ); +end; + procedure TsSpreadOOXMLReader.ApplyCellFormatting(ACell: PCell; XFIndex: Integer); var i: Integer; @@ -556,15 +480,10 @@ begin Result := ''; end; -procedure TsSpreadOOXMLReader.CreateNumFormatList; -begin - FreeAndNil(FNumFormatList); - FNumFormatList := TsOOXMLNumFormatList.Create(Workbook); -end; - procedure TsSpreadOOXMLReader.ReadBorders(ANode: TDOMNode); - function ReadBorderStyle(ANode: TDOMNode; out ABorderStyle: TsCellBorderStyle): Boolean; + function ReadBorderStyle(ANode: TDOMNode; + out ABorderStyle: TsCellBorderStyle): Boolean; var s: String; colorNode: TDOMNode; @@ -675,8 +594,7 @@ var sstIndex: Integer; number: Double; fmt: TsCellFormat; - rng: TsCellRange; - r,c: Cardinal; + numFmt: TsNumFormatParams = nil; begin if ANode = nil then exit; @@ -701,6 +619,9 @@ begin end else InitFormatRecord(fmt); + // get number format parameters + numFmt := Workbook.GetNumberFormat(fmt.NumberFormatIndex); + // get data datanode := ANode.FirstChild; dataStr := ''; @@ -754,10 +675,11 @@ begin if (s = '') or (s = 'n') then begin // Number or date/time, depending on format number := StrToFloat(dataStr, FPointSeparatorSettings); - if IsDateTimeFormat(fmt.NumberFormatStr) then begin - if fmt.NumberFormat <> nfTimeInterval then // no correction of time origin for "time interval" format + if IsDateTimeFormat(numFmt) then + begin + if not IsTimeIntervalFormat(numFmt) then // no correction of time origin for "time interval" format number := ConvertExcelDateTimeToDateTime(number, FDateMode); - AWorksheet.WriteDateTime(cell, number, fmt.NumberFormatStr) + AWorksheet.WriteDateTime(cell, number); end else AWorksheet.WriteNumber(cell, number); @@ -809,8 +731,9 @@ var fmt: TsCellFormat; fs: TsFillStyle; s1, s2: String; - i, numFmtIndex, fillIndex, borderIndex: Integer; - numFmtData: TsNumFormatData; + numFmtIndex, fillIndex, borderIndex: Integer; + numFmtStr: String; + numFmtParams: TsNumFormatParams; fillData: TFillListData; borderData: TBorderListData; fnt: TsFont; @@ -832,14 +755,24 @@ begin if (s1 <> '') and (s2 <> '0') then begin numFmtIndex := StrToInt(s1); - i := NumFormatList.FindByIndex(numFmtIndex); - if i > -1 then + numFmtStr := NumFormatList[numFmtIndex]; + if SameText(numFmtStr, 'General') then + numFmtParams := nil + else begin - numFmtData := NumFormatList.Items[i]; - fmt.NumberFormat := numFmtData.NumFormat; - fmt.NumberFormatStr := numFmtData.FormatString; - if numFmtData.NumFormat <> nfGeneral then - Include(fmt.UsedFormattingFields, uffNumberFormat); + fmt.NumberFormatIndex := Workbook.AddNumberFormat(numFmtStr); + numFmtParams := Workbook.GetNumberFormat(fmt.NumberFormatIndex); + end; + if numFmtParams <> nil then + begin + fmt.NumberFormat := numFmtParams.NumFormat; + fmt.NumberFormatStr := numFmtStr; + Include(fmt.UsedFormattingFields, uffNumberFormat); + end else + begin + fmt.NumberFormat := nfGeneral; + fmt.NumberFormatStr := ''; + Exclude(fmt.UsedFormattingFields, uffNumberFormat); end; end; @@ -851,10 +784,6 @@ begin fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color); if fmt.FontIndex = -1 then fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color); - { - if fmt.FontIndex = BOLD_FONTINDEX then - Include(fmt.UsedFormattingFields, uffBold) - else } if fmt.FontIndex > 0 then Include(fmt.UsedFormattingFields, uffFont); end; @@ -1344,22 +1273,28 @@ begin end; end; - procedure TsSpreadOOXMLReader.ReadNumFormats(ANode: TDOMNode); var node: TDOMNode; idStr: String; fmtStr: String; nodeName: String; + id: Integer; begin - if Assigned(ANode) then begin + if Assigned(ANode) then + begin node := ANode.FirstChild; - while Assigned(node) do begin + while Assigned(node) do + begin nodeName := node.NodeName; - if nodeName = 'numFmt' then begin - idStr := GetAttrValue(node, 'numFmtId'); + if nodeName = 'numFmt' then + begin fmtStr := GetAttrValue(node, 'formatCode'); - NumFormatList.AnalyzeAndAdd(StrToInt(idStr), fmtStr); + idStr := GetAttrValue(node, 'numFmtId'); + id := StrToInt(idStr); + while id >= NumFormatList.Count do + NumFormatList.Add(''); + NumFormatList[id] := fmtStr; end; node := node.NextSibling; end; @@ -1787,7 +1722,33 @@ begin end; -{ TsSpreadOOXMLWriter } +{------------------------------------------------------------------------------} +{ TsSpreadOOXMLWriter } +{------------------------------------------------------------------------------} + +{@@ ---------------------------------------------------------------------------- + Constructor of the OOXML writer + + Defines the date mode and the limitations of the file format. + Initializes the format settings to be used when writing to xml. +-------------------------------------------------------------------------------} +constructor TsSpreadOOXMLWriter.Create(AWorkbook: TsWorkbook); +begin + inherited Create(AWorkbook); + + // Initial base date in case it won't be set otherwise. + // Use 1900 to get a bit more range between 1900..1904. + FDateMode := XlsxSettings.DateMode; + + // Special version of FormatSettings using a point decimal separator for sure. + FPointSeparatorSettings := DefaultFormatSettings; + FPointSeparatorSettings.DecimalSeparator := '.'; + + // http://en.wikipedia.org/wiki/List_of_spreadsheet_software#Specifications + FLimitations.MaxColCount := 16384; + FLimitations.MaxRowCount := 1048576; +end; + {@@ ---------------------------------------------------------------------------- Looks for the combination of border attributes of the given format record in @@ -2044,8 +2005,6 @@ begin ''); // Comments - //IterateThroughComments(FSComments[FCurSheetNum], AWorksheet.Comments, WriteCommentsCallback); - for comment in AWorksheet.Comments do begin txt := comment^.Text; @@ -2068,72 +2027,12 @@ begin ''); end; - (* - procedure TsSpreadOOXMLWriter.WriteCommentsCallback(AComment: PsComment; - ACommentIndex: Integer; AStream: TStream); - var - comment: String; - begin - Unused(ACommentIndex); - - comment := AComment^.Text; - ValidXMLText(comment); - - // Write comment to Comments stream - AppendToStream(AStream, Format( - '', [GetCellString(AComment^.Row, AComment^.Col)])); - AppendToStream(AStream, - ''+ - ''+ - ''+ // this entire node could be omitted, but then Excel uses some default font out of control - ''+ - ''+ // It could be that color index 81 does not exist in fps files --> use rgb instead - ''+ // It is not harmful to Excel if the font does not exist. - ''+ - ''+ - '' + comment + '' + - ''+ - ''); - AppendToStream(AStream, - ''); - end; - *) - // Footer AppendToStream(FSComments[FCurSheetNum], ''); AppendToStream(FSComments[FCurSheetNum], ''); end; - (* -procedure TsSpreadOOXMLWriter.WriteCommentsCallback(AComment: PsComment; - ACommentIndex: Integer; AStream: TStream); -var - comment: String; -begin - Unused(ACommentIndex); - - comment := AComment^.Text; - ValidXMLText(comment); - - // Write comment to Comments stream - AppendToStream(AStream, Format( - '', [GetCellString(AComment^.Row, AComment^.Col)])); - AppendToStream(AStream, - ''+ - ''+ - ''+ // this entire node could be omitted, but then Excel uses some default font out of control - ''+ - ''+ // It could be that color index 81 does not exist in fps files --> use rgb instead - ''+ // It is not harmful to Excel if the font does not exist. - ''+ - ''+ - '' + comment + '' + - ''+ - ''); - AppendToStream(AStream, - ''); -end; *) procedure TsSpreadOOXMLWriter.WriteDimension(AStream: TStream; AWorksheet: TsWorksheet); @@ -2311,31 +2210,33 @@ end; FirstFormatIndexInFile. } procedure TsSpreadOOXMLWriter.WriteNumFormatList(AStream: TStream); var - i: Integer; - item: TsNumFormatData; - s: String; - n: Integer; + i, n: Integer; + numFmtStr: String; + xmlStr: String; + parser: TsNumFormatParser; begin - s := ''; + xmlStr := ''; n := 0; - i := NumFormatList.FindByIndex(NumFormatList.FirstNumFormatIndexInFile); - if i > -1 then begin - while i < NumFormatList.Count do begin - item := NumFormatList[i]; - if item <> nil then begin - s := s + Format('', - [item.Index, UTF8TextToXMLText(NumFormatList.FormatStringForWriting(i))]); - inc(n); - end; - inc(i); + for i:= FFirstNumFormatIndexInFile to NumFormatList.Count-1 do + begin + numFmtStr := NumFormatList[i]; + parser := TsNumFormatParser.Create(Workbook, numFmtStr); + try + numFmtStr := UTF8TextToXMLText(parser.FormatString[nfdExcel]); + xmlStr := xmlStr + Format('', + [i, numFmtStr]); + inc(n); + finally + parser.Free; end; - if n > 0 then - AppendToStream(AStream, Format( - '', [n]), - s, - '' - ); end; + + if n > 0 then + AppendToStream(AStream, Format( + '', [n]), + xmlStr, + '' + ); end; { Writes the workbook's color palette to the file } @@ -2551,7 +2452,8 @@ var // styleCell: TCell; s, sAlign: String; fontID: Integer; - numFmtId: Integer; + numFmtParams: TsNumFormatParams; + numFmtStr: String; fillId: Integer; borderId: Integer; idx: Integer; @@ -2570,19 +2472,18 @@ begin { Number format } if (uffNumberFormat in fmt^.UsedFormattingFields) then begin - idx := NumFormatList.Find(fmt^.NumberFormat, fmt^.NumberFormatStr); - if idx > -1 then begin - numFmtID := NumFormatList[idx].Index; - s := s + Format('numFmtId="%d" applyNumberFormat="1" ', [numFmtId]); - end; + numFmtParams := Workbook.GetNumberFormat(fmt^.NumberFormatIndex); + if numFmtParams <> nil then + begin + numFmtStr := numFmtParams.NumFormatStr[nfdExcel]; + idx := NumFormatList.IndexOf(numFmtStr); + end else + idx := 0; // "General" format is at index 0 + s := s + Format('numFmtId="%d" applyNumberFormat="1" ', [idx]); end; { Font } fontId := 0; - { - if (uffBold in fmt^.UsedFormattingFields) then - fontID := BOLD_FONTINDEX; - } if (uffFont in fmt^.UsedFormattingFields) then fontID := fmt^.FontIndex; s := s + Format('fontId="%d" ', [fontId]); @@ -2715,48 +2616,11 @@ begin ' ' + LineEnding); end; - //IterateThroughComments(FSVmlDrawings[FCurSheetNum], AWorksheet.Comments, WriteVmlDrawingsCallback); - // Footer AppendToStream(FSVmlDrawings[FCurSheetNum], ''); end; -procedure TsSpreadOOXMLWriter.WriteVmlDrawingsCallback(AComment: PsComment; - ACommentIndex: integer; AStream: TStream); -var - id: Integer; -begin - id := 1025 + ACommentIndex; // if more than 1024 comments then use data="1,2,etc" above! -- not implemented yet - - // My xml viewer does not format vml files property --> format in code. - AppendToStream(AStream, LineEnding + Format( - ' ' + LineEnding); -end; - procedure TsSpreadOOXMLWriter.WriteWorksheetRels(AWorksheet: TsWorksheet); var AVLNode: TAVLTreeNode; @@ -2973,12 +2837,7 @@ begin XML_HEADER); AppendToStream(FSContentTypes, ''); - (* - AppendToStream(FSContentTypes, - ''); - AppendToStream(FSContentTypes, - ''); - *) + AppendToStream(FSContentTypes, Format( '', [MIME_RELS])); AppendToStream(FSContentTypes, Format( @@ -3039,30 +2898,21 @@ begin ''); end; -constructor TsSpreadOOXMLWriter.Create(AWorkbook: TsWorkbook); +{@@ ---------------------------------------------------------------------------- + Adds the built-in number formats to the NumFormatList. +-------------------------------------------------------------------------------} +procedure TsSpreadOOXMLWriter.AddBuiltinNumFormats; begin - inherited Create(AWorkbook); - // Initial base date in case it won't be set otherwise. - // Use 1900 to get a bit more range between 1900..1904. - FDateMode := XlsxSettings.DateMode; - - // Special version of FormatSettings using a point decimal separator for sure. - FPointSeparatorSettings := DefaultFormatSettings; - FPointSeparatorSettings.DecimalSeparator := '.'; - - // http://en.wikipedia.org/wiki/List_of_spreadsheet_software#Specifications - FLimitations.MaxColCount := 16384; - FLimitations.MaxRowCount := 1048576; + FFirstNumFormatIndexInFile := 164; + AddBuiltInBiffFormats( + FNumFormatList, Workbook.FormatSettings, FFirstNumFormatIndexInFile-1, nfdExcel + ); end; -procedure TsSpreadOOXMLWriter.CreateNumFormatList; -begin - FreeAndNil(FNumFormatList); - FNumFormatList := TsOOXMLNumFormatList.Create(Workbook); -end; - -{ Creates the streams for the individual data files. Will be zipped into a - single xlsx file. } +{@@ ---------------------------------------------------------------------------- + Creates the streams for the individual data files. Will be zipped into a + single xlsx file. +-------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.CreateStreams; begin if (boBufStream in Workbook.Options) then begin @@ -3085,7 +2935,9 @@ begin // FSSheets will be created when needed. end; -{ Destroys the streams that were created by the writer } +{@@ ---------------------------------------------------------------------------- + Destroys the streams that were created by the writer +-------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.DestroyStreams; procedure DestroyStream(AStream: TStream); @@ -3119,7 +2971,10 @@ begin SetLength(FSVmlDrawings, 0); end; -{ Prepares a string formula for writing } +{@@ ---------------------------------------------------------------------------- + Prepares a string formula for writing: Deletes the leading = sign and makes + sure that it is a valid xml string. +-------------------------------------------------------------------------------} function TsSpreadOOXMLWriter.PrepareFormula(const AFormula: String): String; begin Result := AFormula; @@ -3127,7 +2982,9 @@ begin Result := UTF8TextToXMLText(Result) end; -{ Is called before zipping the individual file parts. Rewinds the streams. } +{@@ ---------------------------------------------------------------------------- + Is called before zipping the individual file parts. Rewinds the streams. +-------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.ResetStreams; var i: Integer; @@ -3144,23 +3001,26 @@ begin for i:=0 to High(FSVmlDrawings) do ResetStream(FSVmlDrawings[i]); end; -{ +{@@ ---------------------------------------------------------------------------- Writes a string to a file. Helper convenience method. -} +-------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.WriteStringToFile(AFileName, AString: string); var - TheStream : TFileStream; + stream : TFileStream; S : String; begin - TheStream := TFileStream.Create(AFileName, fmCreate); - S:=AString; - TheStream.WriteBuffer(Pointer(S)^,Length(S)); - TheStream.Free; + stream := TFileStream.Create(AFileName, fmCreate); + try + S := AString; + stream.WriteBuffer(Pointer(S)^, Length(S)); + finally + stream.Free; + end; end; -{ - Writes an OOXML document to the disc -} +{@@ ---------------------------------------------------------------------------- + Writes an OOXML document to the file +-------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.WriteToFile(const AFileName: string; const AOverwriteExisting: Boolean); var @@ -3188,7 +3048,7 @@ var i: Integer; begin { Analyze the workbook and collect all information needed } - ListAllNumFormats; + ListAllNumFormats(nfdExcel); ListAllFills; ListAllBorders; @@ -3259,7 +3119,9 @@ begin ''); end; -{ Writes a boolean value to the stream } +{@@ ---------------------------------------------------------------------------- + Writes a boolean value to the stream +-------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.WriteBool(AStream: TStream; const ARow, ACol: Cardinal; const AValue: Boolean; ACell: PCell); var @@ -3274,7 +3136,9 @@ begin '%s', [CellPosText, lStyleIndex, CellValueText])); end; -{ Writes an error value to the specified cell. } +{@@ ---------------------------------------------------------------------------- + Writes an error value to the specified cell. +-------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.WriteError(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell); begin @@ -3283,7 +3147,9 @@ begin Unused(AValue, ACell); end; -{ Writes a string formula to the given cell. } +{@@ ---------------------------------------------------------------------------- + Writes a string formula to the given cell. +-------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); var @@ -3386,9 +3252,9 @@ begin inc(FSharedStringsCount); end; -{ - Writes a number (64-bit IEE 754 floating point) to the sheet -} +{@@ ---------------------------------------------------------------------------- + Writes a number (64-bit IEE 754 floating point) to the stream +-------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); var @@ -3403,12 +3269,11 @@ begin '%s', [CellPosText, lStyleIndex, CellValueText])); end; -{******************************************************************* -* TsSpreadOOXMLWriter.WriteDateTime () -* -* DESCRIPTION: Writes a date/time value as a number -* Respects DateMode of the file -*******************************************************************} +{@@ ---------------------------------------------------------------------------- + Writes a date/time value as a number + + Respects DateMode of the file +-------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); var @@ -3418,12 +3283,13 @@ begin WriteNumber(AStream, ARow, ACol, ExcelDateSerial, ACell); end; -{ - Registers this reader / writer on fpSpreadsheet -} + initialization + // Registers this reader / writer on fpSpreadsheet RegisterSpreadFormat(TsSpreadOOXMLReader, TsSpreadOOXMLWriter, sfOOXML); + + // Create color palette for OOXML file format MakeLEPalette(@PALETTE_OOXML, Length(PALETTE_OOXML)); end.