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