diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm b/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm index 9edf48509..8e7b5b06d 100644 --- a/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm +++ b/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm @@ -820,6 +820,77 @@ object MainForm: TMainForm Hint = 'Currency format (negative values in red)' NumberFormat = nfCurrencyRed end + object AcFileOpen: TFileOpen + Category = 'File' + Caption = '&Open ...' + Dialog.Filter = 'All spreadsheet files|*.xls;*.xlsx;*.ods;*.csv|All Excel files (*.xls, *.xlsx)|*.xls;*.xlsx|Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited files (*.csv)|*.csv' + Dialog.Options = [ofExtensionDifferent, ofFileMustExist, ofEnableSizing, ofViewDetail] + Hint = 'Open spreadsheet file' + ImageIndex = 44 + ShortCut = 16463 + OnAccept = AcFileOpenAccept + end + object AcFileSaveAs: TFileSaveAs + Category = 'File' + Caption = 'Save &as ...' + Dialog.Title = 'AcSaveFileAs' + Dialog.Filter = 'Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited files (*.csv)|*.csv|WikiTable (WikiMedia-Format, *.wikitable_wikimedia)|*.wikitable_wikimedia' + Hint = 'Save spreadsheet' + ImageIndex = 45 + OnAccept = AcFileSaveAsAccept + end + object AcViewInspector: TAction + Category = 'View' + AutoCheck = True + Caption = 'Inspector' + OnExecute = AcViewInspectorExecute + end + object AcRowAdd: TAction + Category = 'Edit' + Caption = 'Add row' + Hint = 'Add row' + ImageIndex = 48 + OnExecute = AcRowAddExecute + end + object AcColAdd: TAction + Category = 'Edit' + Caption = 'Add column' + Hint = 'Add column' + ImageIndex = 47 + OnExecute = AcColAddExecute + end + object AcRowDelete: TAction + Category = 'Edit' + Caption = 'Delete row' + Hint = 'Delete row' + ImageIndex = 50 + OnExecute = AcRowDeleteExecute + end + object AcColDelete: TAction + Category = 'Edit' + Caption = 'Delete column' + Hint = 'Delete column' + ImageIndex = 49 + OnExecute = AcColDeleteExecute + end + object AcSettingsCSVParams: TAction + Category = 'Settings' + Caption = 'CSV parameters...' + Hint = 'Parameters for CSV files' + OnExecute = AcSettingsCSVParamsExecute + end + object AcSettingsCurrency: TAction + Category = 'Settings' + Caption = 'Currency symbols...' + Hint = 'Define currency symbols' + OnExecute = AcSettingsCurrencyExecute + end + object AcSettingsFormatSettings: TAction + Category = 'Settings' + Caption = 'Number format settings...' + Hint = 'Define number format settings' + OnExecute = AcSettingsFormatSettingsExecute + end object AcNumFormatExp: TsNumberFormatAction Category = 'FPSpreadsheet' WorkbookSource = WorkbookSource @@ -827,6 +898,27 @@ object MainForm: TMainForm Hint = 'Exponential format' NumberFormat = nfExp end + object AcNumFormatFraction1: TsNumberFormatAction + Category = 'FPSpreadsheet' + WorkbookSource = WorkbookSource + Caption = 'Fraction (1 digit)' + NumberFormat = nfFraction + NumberFormatString = '#" "#/#' + end + object AcNumFormatFraction2: TsNumberFormatAction + Category = 'FPSpreadsheet' + WorkbookSource = WorkbookSource + Caption = 'Fraction (2 digits)' + NumberFormat = nfFraction + NumberFormatString = '#" "##/##' + end + object AcNumFormatFraction3: TsNumberFormatAction + Category = 'FPSpreadsheet' + WorkbookSource = WorkbookSource + Caption = 'Fraction (3 digits)' + NumberFormat = nfFraction + NumberFormatString = '#" "###/###' + end object AcNumFormatDateTime: TsNumberFormatAction Category = 'FPSpreadsheet' WorkbookSource = WorkbookSource @@ -1323,25 +1415,6 @@ object MainForm: TMainForm Hint = 'Merge cells' ImageIndex = 23 end - object AcFileOpen: TFileOpen - Category = 'File' - Caption = '&Open ...' - Dialog.Filter = 'All spreadsheet files|*.xls;*.xlsx;*.ods;*.csv|All Excel files (*.xls, *.xlsx)|*.xls;*.xlsx|Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited files (*.csv)|*.csv' - Dialog.Options = [ofExtensionDifferent, ofFileMustExist, ofEnableSizing, ofViewDetail] - Hint = 'Open spreadsheet file' - ImageIndex = 44 - ShortCut = 16463 - OnAccept = AcFileOpenAccept - end - object AcFileSaveAs: TFileSaveAs - Category = 'File' - Caption = 'Save &as ...' - Dialog.Title = 'AcSaveFileAs' - Dialog.Filter = 'Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited files (*.csv)|*.csv|WikiTable (WikiMedia-Format, *.wikitable_wikimedia)|*.wikitable_wikimedia' - Hint = 'Save spreadsheet' - ImageIndex = 45 - OnAccept = AcFileSaveAsAccept - end object AcCopyFormat: TsCopyAction Category = 'FPSpreadsheet' WorkbookSource = WorkbookSource @@ -1349,40 +1422,6 @@ object MainForm: TMainForm Hint = 'Copy format' ImageIndex = 46 end - object AcViewInspector: TAction - Category = 'View' - AutoCheck = True - Caption = 'Inspector' - OnExecute = AcViewInspectorExecute - end - object AcRowAdd: TAction - Category = 'Edit' - Caption = 'Add row' - Hint = 'Add row' - ImageIndex = 48 - OnExecute = AcRowAddExecute - end - object AcColAdd: TAction - Category = 'Edit' - Caption = 'Add column' - Hint = 'Add column' - ImageIndex = 47 - OnExecute = AcColAddExecute - end - object AcRowDelete: TAction - Category = 'Edit' - Caption = 'Delete row' - Hint = 'Delete row' - ImageIndex = 50 - OnExecute = AcRowDeleteExecute - end - object AcColDelete: TAction - Category = 'Edit' - Caption = 'Delete column' - Hint = 'Delete column' - ImageIndex = 49 - OnExecute = AcColDeleteExecute - end object AcCopyToClipboard: TsCopyAction Category = 'FPSpreadsheet' WorkbookSource = WorkbookSource @@ -1452,24 +1491,6 @@ object MainForm: TMainForm Hint = 'Delete comment' ImageIndex = 55 end - object AcSettingsCSVParams: TAction - Category = 'Settings' - Caption = 'CSV parameters...' - Hint = 'Parameters for CSV files' - OnExecute = AcSettingsCSVParamsExecute - end - object AcSettingsCurrency: TAction - Category = 'Settings' - Caption = 'Currency symbols...' - Hint = 'Define currency symbols' - OnExecute = AcSettingsCurrencyExecute - end - object AcSettingsFormatSettings: TAction - Category = 'Settings' - Caption = 'Number format settings...' - Hint = 'Define number format settings' - OnExecute = AcSettingsFormatSettingsExecute - end object AcHyperlinkNew: TsCellHyperlinkAction Category = 'FPSpreadsheet' WorkbookSource = WorkbookSource @@ -4828,6 +4849,21 @@ object MainForm: TMainForm object MenuItem13: TMenuItem Caption = '-' end + object MenuItem117: TMenuItem + Action = AcNumFormatFraction1 + AutoCheck = True + end + object MenuItem116: TMenuItem + Action = AcNumFormatFraction2 + AutoCheck = True + end + object MenuItem115: TMenuItem + Action = AcNumFormatFraction3 + AutoCheck = True + end + object MenuItem114: TMenuItem + Caption = '-' + end object MenuItem53: TMenuItem Action = AcNumFormatExp AutoCheck = True @@ -4970,6 +5006,21 @@ object MainForm: TMainForm object MenuItem20: TMenuItem Caption = '-' end + object MenuItem112: TMenuItem + Action = AcNumFormatFraction1 + AutoCheck = True + end + object MenuItem110: TMenuItem + Action = AcNumFormatFraction2 + AutoCheck = True + end + object MenuItem113: TMenuItem + Action = AcNumFormatFraction3 + AutoCheck = True + end + object MenuItem111: TMenuItem + Caption = '-' + end object MenuItem21: TMenuItem Action = AcNumFormatExp AutoCheck = True diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/main.pas b/components/fpspreadsheet/examples/visual/fpsctrls/main.pas index f634b9cac..be62fffbb 100644 --- a/components/fpspreadsheet/examples/visual/fpsctrls/main.pas +++ b/components/fpspreadsheet/examples/visual/fpsctrls/main.pas @@ -40,6 +40,14 @@ type MenuItem107: TMenuItem; MenuItem108: TMenuItem; MenuItem109: TMenuItem; + MenuItem110: TMenuItem; + MenuItem111: TMenuItem; + MenuItem112: TMenuItem; + MenuItem113: TMenuItem; + MenuItem114: TMenuItem; + MenuItem115: TMenuItem; + MenuItem116: TMenuItem; + MenuItem117: TMenuItem; MnuSettings: TMenuItem; MenuItem11: TMenuItem; MenuItem12: TMenuItem; @@ -224,6 +232,9 @@ type AcHyperlinkNew: TsCellHyperlinkAction; AcHyperlinkEdit: TsCellHyperlinkAction; AcHyperlinkDelete: TsCellHyperlinkAction; + AcNumFormatFraction2: TsNumberFormatAction; + AcNumFormatFraction1: TsNumberFormatAction; + AcNumFormatFraction3: TsNumberFormatAction; Splitter2: TSplitter; Splitter3: TSplitter; ToolBar2: TToolBar; diff --git a/components/fpspreadsheet/fpsnumformat.pas b/components/fpspreadsheet/fpsnumformat.pas index c4e289c07..87aac1b26 100644 --- a/components/fpspreadsheet/fpsnumformat.pas +++ b/components/fpspreadsheet/fpsnumformat.pas @@ -78,6 +78,8 @@ type property Items[AIndex: Integer]: TsNumFormatData read GetItem write SetItem; default; end; +function FormatAsFraction(ANumFormatStr: String; AValue: Double): String; + function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean; function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; overload; function IsDateTimeFormat(AFormatStr: String): Boolean; overload; @@ -91,6 +93,50 @@ uses Math, fpsUtils, fpsNumFormatParser; +{@@ ---------------------------------------------------------------------------- + Formats a floating point value as a fraction according to the specified + formatting string. + + @param ANumFormatStr String with formatting codes +-------------------------------------------------------------------------------} +function FormatAsFraction(ANumFormatStr: String; AValue: Double): String; +var + parser: TsNumFormatParser; + int,num,denom: Integer; + maxNum, maxDenom: Integer; + isNeg: Boolean; +begin + if AValue < 0 then begin + isNeg := true; + AValue := abs(AValue); + end else + isNeg := false; + + parser := TsNumFormatParser.Create(nil, ANumFormatStr); + try + if parser.NumFormat <> nfFraction then + raise Exception.Create('[FormatAsFraction] No formatting string for fractions.'); + + if parser.FracInt = 0 then + int := 0 + else + begin + int := trunc(AValue); + AValue := frac(AValue); + end; + maxNum := Round(IntPower(10, parser.FracNumerator)); + maxDenom := Round(IntPower(10, parser.FracDenominator)); + FloatToFraction(AValue, maxNum, maxDenom, num, denom); + if int = 0 then + Result := Format('%d/%d', [num, denom]) + else + Result := Format('%d %d/%d', [int, num, denom]); + if isNeg then Result := '-' + Result; + finally + parser.Free; + end; +end; + {@@ ---------------------------------------------------------------------------- Checks whether the given number format code is for currency, i.e. requires currency symbol. diff --git a/components/fpspreadsheet/fpsnumformatparser.pas b/components/fpspreadsheet/fpsnumformatparser.pas index 85791d608..0f68949c7 100644 --- a/components/fpspreadsheet/fpsnumformatparser.pas +++ b/components/fpspreadsheet/fpsnumformatparser.pas @@ -29,9 +29,10 @@ type nftYear, nftMonth, nftDay, nftHour, nftMinute, nftSecond, nftMilliseconds, nftAMPM, nftMonthMinute, nftDateTimeSep, nftSign, nftSignBracket, - nftDigit, nftOptDigit, nftDecs, nftOptDec, + nftDigit, nftOptDigit, nftOptSpaceDigit, nftDecs, nftOptDec, nftExpChar, nftExpSign, nftExpDigits, nftPercent, + nftFraction, nftCurrSymbol, nftCountry, nftColor, nftCompareOp, nftCompareValue, nftSpace, nftEscaped, @@ -51,6 +52,9 @@ type Elements: TsNumFormatElements; NumFormat: TsNumberFormat; Decimals: Byte; + FracInt: Integer; + FracNumerator: Integer; + FracDenominator: Integer; CurrencySymbol: String; Color: TsColor; end; @@ -69,6 +73,9 @@ type FStatus: Integer; function GetCurrencySymbol: String; function GetDecimals: byte; + function GetFracDenominator: Integer; + function GetFracInt: Integer; + function GetFracNumerator: Integer; function GetFormatString(ADialect: TsNumFormatDialect): String; function GetNumFormat: TsNumberFormat; function GetParsedSectionCount: Integer; @@ -115,10 +122,13 @@ type // Format string function BuildFormatString(ADialect: TsNumFormatDialect): String; virtual; function BuildFormatStringFromSection(ASection: Integer; - ADialect: TsNumFormatDialect): String; virtual; + ADialect: TsNumFormatDialect; AStartIndex: Integer = 0): String; virtual; // NumberFormat - procedure EvalNumFormatOfSection(ASection: Integer; out ANumFormat: TsNumberFormat; - out ADecimals: byte; out ACurrencySymbol: String; out AColor: TsColor); + procedure EvalNumFormatOfSection(ASection: Integer); + {; out ANumFormat: TsNumberFormat; + out ADecimals: byte; out ANumerator, ADenominator: Integer; + out ACurrencySymbol: String; out AColor: TsColor); + } function IsCurrencyAt(ASection: Integer; out ANumFormat: TsNumberFormat; out ADecimals: byte; out ACurrencySymbol: String; out AColor: TsColor): Boolean; function IsDateAt(ASection,AIndex: Integer; out ANumberFormat: TsNumberFormat; @@ -144,6 +154,9 @@ type property CurrencySymbol: String read GetCurrencySymbol; property Decimals: Byte read GetDecimals write SetDecimals; property FormatString[ADialect: TsNumFormatDialect]: String read GetFormatString; + property FracDenominator: Integer read GetFracDenominator; + property FracInt: Integer read GetFracInt; + property FracNumerator: Integer read GetFracNumerator; property NumFormat: TsNumberFormat read GetNumFormat; property ParsedSectionCount: Integer read GetParsedSectionCount; property ParsedSections[AIndex: Integer]: TsNumFormatSection read GetParsedSections; @@ -283,7 +296,7 @@ end; { Creates a format string for the given section. This implementation covers the formatstring dialects of fpc (nfdDefault) and Excel (nfdExcel). } function TsNumFormatParser.BuildFormatStringFromSection(ASection: Integer; - ADialect: TsNumFormatDialect): String; + ADialect: TsNumFormatDialect; AStartIndex: Integer = 0): String; var element: TsNumFormatElement; i: Integer; @@ -303,6 +316,8 @@ begin Result := Result + '0'; nftOptDigit, nftOptDec: Result := Result + '#'; + nftOptSpaceDigit: + Result := Result + '#'; /// !!!!!!!!!!! TO BE CHANGED !!!!!!!!!!!!!!!!! nftYear: Result := Result + DupeString(IfThen(ADialect = nfdExcel, 'Y', 'y'), element.IntValue); nftMonth: @@ -324,7 +339,7 @@ begin nftDecs, nftExpDigits, nftMilliseconds: Result := Result + Dupestring('0', element.IntValue); nftSpace, nftSign, nftSignBracket, nftExpChar, nftExpSign, nftPercent, - nftAMPM, nftDateTimeSep: + nftFraction, nftAMPM, nftDateTimeSep: if element.TextValue <> '' then Result := Result + element.TextValue; nftCurrSymbol: if element.TextValue <> '' then begin @@ -443,12 +458,16 @@ begin end; end; - EvalNumFormatOfSection(ASection, + EvalNumFormatOfSection(ASection); + { FSections[ASection].NumFormat, FSections[ASection].Decimals, + FSections[ASection].Numerator, + FSections[ASection].Denominator, FSections[ASection].CurrencySymbol, FSections[ASection].Color ); + } end; procedure TsNumFormatParser.ClearAll; @@ -526,33 +545,68 @@ begin end; end; -procedure TsNumFormatParser.EvalNumFormatOfSection(ASection: Integer; - out ANumFormat: TsNumberFormat; out ADecimals: byte; out ACurrencySymbol: String; +procedure TsNumFormatParser.EvalNumFormatOfSection(ASection: Integer); +{ + out ANumFormat: TsNumberFormat; out ADecimals: byte; + out ANumerator, ADenominator: Integer; out ACurrencySymbol: String; out AColor: TsColor); + } var - nf: TsNumberFormat; + nf, nf1: TsNumberFormat; next: Integer = 0; + decs, num, denom: Byte; + cs: String; + clr: TsColor; begin - ANumFormat := nfCustom; - ADecimals := 0; - ACurrencySymbol := ''; - AColor := scNotDefined; + nf := nfCustom; + decs := 0; + num := 0; + denom := 0; + cs := ''; + clr := scNotDefined; with FSections[ASection] do begin if Length(Elements) = 0 then begin - ANumFormat := nfGeneral; + FSections[ASection].NumFormat := nfGeneral; exit; end; // Look for number formats - if IsNumberAt(ASection, 0, ANumFormat, ADecimals, next) then begin + if IsNumberAt(ASection, 0, nf, decs, next) then begin // nfFixed, nfFixedTh if next = Length(Elements) then + begin + FSections[ASection].NumFormat := nf; + FSections[ASection].Decimals := decs; exit; + end; // nfPercentage if IsTokenAt(nftPercent, ASection, next) and (next+1 = Length(Elements)) then begin - ANumFormat := nfPercentage; + FSections[ASection].NumFormat := nfPercentage; + FSections[ASection].Decimals := decs; + exit; + end; + // nfFraction + if IsTextAt(' ', ASection, next) and + IsNumberAt(ASection, next+1, nf, num, next) and + IsTokenAt(nftFraction, ASection, next) and + IsNumberAt(ASection, next+1, nf, denom, next) and + (next = Length(Elements)) + then begin + FSections[ASection].NumFormat := nfFraction; + FSections[ASection].FracInt := integer(decs); // "decs" means "number of integer digits", here + FSections[ASection].FracNumerator := integer(num); + FSections[ASection].FracDenominator := integer(denom); + exit; + end; + if IsTokenAt(nftFraction, ASection, next) and + IsNumberAt(ASection, next+1, nf, denom, next) and + (next = Length(Elements)) + then begin + FSections[ASection].NumFormat := nfFraction; + FSections[ASection].FracNumerator := integer(decs); + FSections[ASection].FracDenominator := integer(denom); exit; end; // nfExp @@ -560,38 +614,53 @@ 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; + if nf = nfFixed then + begin + FSections[ASection].NumFormat := nfExp; + FSections[ASection].Decimals := decs; + exit; + end; end; end; end; // Currency? - if IsCurrencyAt(ASection, ANumFormat, ADecimals, ACurrencySymbol, AColor) - then exit; + if IsCurrencyAt(ASection, nf, decs, cs, clr) then + begin + FSections[ASection].NumFormat := nf; + FSections[ASection].Decimals := decs; + FSections[ASection].CurrencySymbol := cs; + FSections[ASection].Color := clr; + exit; + end; // Look for date formats - if IsDateAt(ASection, 0, ANumFormat, next) then begin + if IsDateAt(ASection, 0, nf, next) then begin if (next = Length(Elements)) then + begin + FSections[ASection].NumFormat := nf; exit; - if IsTextAt(' ', ASection, next) and IsTimeAt(ASection, next+1, nf, next) and + end; + if IsTokenAt(nftSpace, ASection, next) and IsTimeAt(ASection, next+1, nf1, next) and (next = Length(Elements)) then begin - if (ANumFormat = nfShortDate) and (nf = nfShortTime) then - ANumFormat := nfShortDateTime; + if (nf = nfShortDate) and (nf1 = nfShortTime) then + FSections[ASection].NumFormat := nfShortDateTime; end; exit; end; // Look for time formats - if IsTimeAt(ASection, 0, ANumFormat, next) then + if IsTimeAt(ASection, 0, nf, next) then if next = Length(Elements) then + begin + FSections[ASection].NumFormat := nf; exit; + end; end; // What is left must be a custom format. - ANumFormat := nfCustom; + FSections[ASection].NumFormat := nfCustom; end; { Extracts the currency symbol form the formatting sections. It is assumed that @@ -647,6 +716,30 @@ begin Result := 0; end; +function TsNumFormatParser.GetFracDenominator: Integer; +begin + if Length(FSections) > 0 then + Result := FSections[0].FracDenominator + else + Result := 0; +end; + +function TsNumFormatParser.GetFracInt: Integer; +begin + if Length(FSections) > 0 then + Result := FSections[0].FracInt + else + Result := 0; +end; + +function TsNumFormatParser.GetFracNumerator: Integer; +begin + if Length(FSections) > 0 then + Result := FSections[0].FracNumerator + 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. } @@ -882,10 +975,13 @@ 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. } + Returns TRUE if it does. + NOTE: ADecimals can have various meanings -- see EvalNumFormatOfSection} function TsNumFormatParser.IsNumberAt(ASection,AIndex: Integer; out ANumberFormat: TsNumberFormat; out ADecimals: Byte; out ANextIndex: Integer): Boolean; +var + i: Integer; begin Result := false; ANumberFormat := nfGeneral; @@ -911,28 +1007,56 @@ begin 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 + if IsTokenAt(nftOptDigit, ASection, AIndex) then begin // '#' + if 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 - // This is the case with decimal separator, like "#,##0.000" - Result := true; - ANumberFormat := nfFixedTh; - ADecimals := FSections[ASection].Elements[AIndex+6].IntValue; - ANextIndex := AIndex+7; + 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 else - if not IsTokenAt(nftDecSep, ASection, AIndex+5) then begin - // and this is without decimal separator, "#,##0" + begin // Isolated '#' result := true; - ANumberFormat := nfFixedTh; - ADecimals := 0; - ANextIndex := AIndex + 5; + inc(AIndex); + ANextIndex := AIndex; + ADecimals := 1; + while IsTokenAt(nftOptDigit, ASection, AIndex) do + begin + inc(AIndex); + inc(ANextIndex); + inc(ADecimals); + end; + ANumberFormat := nfFraction; end; + end else + if IsTokenAt(nftOptSpaceDigit, ASection, AIndex) then // '?' + begin + Result := true; + inc(AIndex); + ANextIndex := AIndex; + ADecimals := 1; + while IsTokenAt(nftOptSpaceDigit, ASection, AIndex) do + begin + inc(AIndex); + inc(ANextIndex); + inc(ADecimals); + end; + ANumberFormat := nfFraction; end; end; @@ -1024,7 +1148,7 @@ function TsNumFormatParser.IsTimeAt(ASection,AIndex: Integer; exit; end; end; - Result := true; + Result := i >= Length(AFmtStr); //true; end; var @@ -1053,7 +1177,7 @@ begin ANumberFormat := IfThen(AMPM, nfShortTimeAM, nfShortTime); exit; end; - fmt := AddAMPM(FWorkbook.FormatSettings.ShortTimeFormat, FWorkbook.FormatSettings); + fmt := FWorkbook.FormatSettings.ShortTimeFormat; if CheckFormat(fmt, ANextIndex, AMPM, isInterval) then begin ANumberFormat := IfThen(AMPM, nfShortTimeAM, nfShortTime); exit; @@ -1454,7 +1578,7 @@ begin ScanQuotedText; '(', ')': AddElement(nftSignBracket, FToken); - '0', '#', '.', ',', '-': + '0', '#', '?', '.', ',', '-': ScanNumber; 'y', 'Y', 'm', 'M', 'd', 'D', 'h', 'N', 'n', 's': ScanDateTime; @@ -1514,7 +1638,9 @@ begin '+', '-': AddElement(nftSign, FToken); '#': AddElement(nftOptDigit, FToken); + '?': AddElement(nftOptSpaceDigit, FToken); '%': AddElement(nftPercent, FToken); + '/': AddElement(nftFraction, FToken); else FToken := PrevToken; Exit; diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index ce5b401b0..fc1535fd6 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -508,6 +508,7 @@ var s: String; isTimeOnly: Boolean; isInterval: Boolean; + num, denom: byte; begin Result := ''; @@ -571,6 +572,39 @@ begin exit; end; + // nfFraction + if IsTextAt(' ', ASection, next) and + IsNumberAt(ASection, next+1, nf, num, next) and + IsTokenAt(nftFraction, ASection, next) and + IsNumberAt(ASection, next+1, nf, denom, next) and + (next = Length(Elements)) + then begin + Result := + '' + + sColor + + '' + + ''; + exit; + end; + if IsTokenAt(nftFraction, ASection, next) and + IsNumberAt(ASection, next+1, nf, denom, next) and + (next = Length(Elements)) + then begin + Result := + '' + + sColor + + '' + + ''; + exit; + end; + // nfPercentage if IsTokenAt(nftPercent, ASection, next) and (next+1 = Length(Elements)) then begin @@ -1678,6 +1712,7 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode); nfs: String; decs: Byte; s: String; + fracInt, fracNum, fracDenom: Integer; grouping: Boolean; nex: Integer; cs: String; @@ -1697,11 +1732,6 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode); end else if nodeName = 'number:number' then begin - { - if ANumFormatName = 'number:currency-style' then - s := GetAttrValue(node, 'decimal-places') - else - } s := GetAttrValue(node, 'number:decimal-places'); if s = '' then s := GetAttrValue(node, 'decimal-places'); if s <> '' then decs := StrToInt(s) else decs := 0; @@ -1709,6 +1739,17 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode); nf := IfThen(grouping, nfFixedTh, nfFixed); nfs := nfs + BuildNumberFormatString(nf, Workbook.FormatSettings, decs); end else + if nodeName = 'number:fraction' then + begin + nf := nfFraction; + s := GetAttrValue(node, 'number:min-integer-digits'); + if s <> '' then fracInt := StrToInt(s) else fracInt := 0; + s := GetAttrValue(node, 'number:min-numerator-digits'); + if s <> '' then fracNum := StrToInt(s) else fracNum := 0; + s := GetAttrValue(node, 'number:min-denominator-digits'); + if s <> '' then fracDenom := StrToInt(s) else fracDenom := 0; + nfs := nfs + BuildFractionFormatString(fracInt > 0, fracNum, fracDenom); + end else if nodeName = 'number:scientific-number' then begin nf := nfExp; diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index a62dd2f26..6d5c40d29 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -312,6 +312,10 @@ type procedure WriteNumberFormat(ACell: PCell; ANumFormat: TsNumberFormat; ADecimals: Integer; ACurrencySymbol: String = ''; APosCurrFormat: Integer = -1; ANegCurrFormat: Integer = -1); overload; + function WriteFractionFormat(ARow, ACol: Cardinal; AMixedFraction: Boolean; + ANumeratorDigits, ADenominatorDigits: Integer): PCell; overload; + procedure WriteFractionFormat(ACell: PCell; AMixedFraction: Boolean; + ANumeratorDigits, ADenominatorDigits: Integer); overload; function WriteTextRotation(ARow, ACol: Cardinal; ARotation: TsTextRotation): PCell; overload; procedure WriteTextRotation(ACell: PCell; ARotation: TsTextRotation); overload; @@ -2514,6 +2518,8 @@ function TsWorksheet.ReadAsUTF8Text(ACell: PCell; function FloatToStrNoNaN(const AValue: Double; ANumberFormat: TsNumberFormat; ANumberFormatStr: string): string; //ansistring; + var + i: Integer; begin if IsNan(AValue) then Result := '' @@ -2524,6 +2530,9 @@ function TsWorksheet.ReadAsUTF8Text(ACell: PCell; if (ANumberFormat = nfPercentage) then Result := FormatFloat(ANumberFormatStr, AValue*100, AFormatSettings) else + if (ANumberFormat = nfFraction) then + Result := FormatAsFraction(ANumberFormatStr, AValue) + else if IsCurrencyFormat(ANumberFormat) then Result := FormatCurr(ANumberFormatStr, AValue, AFormatSettings) else @@ -4026,6 +4035,7 @@ var number: Double; currSym: String; fmt: TsCellFormat; + maxDig: Integer; begin if ACell = nil then exit; @@ -4047,6 +4057,13 @@ begin exit; end; + if TryFractionStrToFloat(AValue, number, maxdig) then + begin + WriteNumber(ACell, number); + WriteFractionFormat(ACell, true, maxdig, maxdig); + exit; + end; + if TryStrToFloat(AValue, number, FWorkbook.FormatSettings) then begin if isPercent then @@ -4616,7 +4633,56 @@ begin end; {@@ ---------------------------------------------------------------------------- - Adds number format to the formatting of a cell + Formats a number as a fraction + + @param ARow Row index of the cell + @param ACol Column index of the cell + @param ANumFormat Identifier of the format to be applied. Must be + either nfFraction or nfMixedFraction + @param ANumeratorDigts Count of numerator digits + @param ADenominatorDigits Count of denominator digits + @return Pointer to the cell + + @see TsNumberFormat +-------------------------------------------------------------------------------} +function TsWorksheet.WriteFractionFormat(ARow, ACol: Cardinal; + AMixedFraction: Boolean; ANumeratorDigits, ADenominatorDigits: Integer): PCell; +begin + Result := GetCell(ARow, ACol); + WriteFractionFormat(Result, AMixedFraction, ANumeratorDigits, ADenominatorDigits); +end; + +{@@ ---------------------------------------------------------------------------- + Formats a number as a fraction + + @param ACell Pointer to the cell to be formatted + @param ANumFormat Identifier of the format to be applied. Must be + either nfFraction or nfMixedFraction + @param ANumeratorDigts Count of numerator digits + @param ADenominatorDigits Count of denominator digits + + @see TsNumberFormat +-------------------------------------------------------------------------------} +procedure TsWorksheet.WriteFractionFormat(ACell: PCell; + AMixedFraction: Boolean; ANumeratorDigits, ADenominatorDigits: Integer); +var + fmt: TsCellFormat; +begin + if ACell = nil then + exit; + + fmt := Workbook.GetCellFormat(ACell^.FormatIndex); + fmt.NumberFormat := nfFraction; + fmt.NumberFormatStr := BuildFractionFormatString(AMixedFraction, + ANumeratorDigits, ADenominatorDigits); + Include(fmt.UsedFormattingFields, uffNumberFormat); + ACell^.FormatIndex := Workbook.AddCellFormat(fmt); + + ChangedCell(ACell^.Row, ACell^.Col); +end; + +{@@ ---------------------------------------------------------------------------- + Adds a number format to the formatting of a cell @param ARow The row of the cell @param ACol The column of the cell diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas index fc0e014d9..5e7b7682c 100644 --- a/components/fpspreadsheet/fpstypes.pas +++ b/components/fpspreadsheet/fpstypes.pas @@ -203,7 +203,7 @@ type // general-purpose for all numbers nfGeneral, // numbers - nfFixed, nfFixedTh, nfExp, nfPercentage, + nfFixed, nfFixedTh, nfExp, nfPercentage, nfFraction, // currency nfCurrency, nfCurrencyRed, // dates and times diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 740db3d04..ea8f3875e 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -101,6 +101,8 @@ function BuildCurrencyFormatString(ADialect: TsNumFormatDialect; ADecimals, APosCurrFormat, ANegCurrFormat: Integer; ACurrencySymbol: String): String; function BuildDateTimeFormatString(ANumberFormat: TsNumberFormat; const AFormatSettings: TFormatSettings; AFormatString: String = ''): String; +function BuildFractionFormatString(AMixedFraction: Boolean; + ANumeratorDigits, ADenominatorDigits: Integer): String; function BuildNumberFormatString(ANumberFormat: TsNumberFormat; const AFormatSettings: TFormatSettings; ADecimals: Integer = -1): String; @@ -111,6 +113,8 @@ function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte; function AddIntervalBrackets(AFormatString: String): String; function DayNamesToString(const ADayNames: TWeekNameArray; const AEmptyStr: String): String; +procedure FloatToFraction(AValue: Double; AMaxNumerator, AMaxDenominator: Integer; + out ANumerator, ADenominator: Integer); function MakeLongDateFormat(ADateFormat: String): String; function MakeShortDateFormat(ADateFormat: String): String; function MonthNamesToString(const AMonthNames: TMonthNameArray; @@ -125,6 +129,9 @@ procedure MakeTimeIntervalMask(Src: String; var Dest: String); function TryStrToFloatAuto(AText: String; out ANumber: Double; out ADecimalSeparator, AThousandSeparator: Char; out AWarning: String): Boolean; +function TryFractionStrToFloat(AText: String; out ANumber: Double; + out AMaxDigits: Integer): Boolean; + function TwipsToPts(AValue: Integer): Single; function PtsToTwips(AValue: Single): Integer; function cmToPts(AValue: Double): Double; @@ -1127,6 +1134,26 @@ begin end; end; +{@@ ---------------------------------------------------------------------------- + Builds a number format string for fraction formatting from the number format + code and the count of numerator and denominator digits. + + @param AMixedFraction If TRUE fraction is presented as mixed fraction + @param ANumeratorDigits Count of numerator digits + @param ADenominatorDigits Count of denominator digits + + @return String of formatting code, here something like: '##/##' or '# ##/##' +-------------------------------------------------------------------------------} +function BuildFractionFormatString(AMixedFraction: Boolean; + ANumeratorDigits, ADenominatorDigits: Integer): String; +begin + Result := Format('%s/%s', [ + DupeString('#', ANumeratorDigits), DupeString('#', ADenominatorDigits) + ]); + if AMixedFraction then + Result := '#" "' + Result; +end; + {@@ ---------------------------------------------------------------------------- Builds a number format string from the number format code and the count of decimal places. @@ -1306,6 +1333,99 @@ begin end; end; +{@@ ---------------------------------------------------------------------------- + Approximates a floating point value as a fraction and returns the values of + numerator and denominator. + + @param AValue Floating point value to be analyzed + @param AMaxNumerator Maximum value of the numerator allowed + @param AMaxDenominator Maximum value of the denominator allowed + @param ANumerator (out) Numerator of the best approximating fraction + @param ADenominator (out) Denominator of the best approximating fraction +-------------------------------------------------------------------------------} +procedure FloatToFraction(AValue: Double; AMaxNumerator, AMaxDenominator: Integer; + out ANumerator, ADenominator: Integer); +// "Stern-Brocot-Tree" +// Original from : http://stackoverflow.com/questions/5124743/algorithm-for-simplifying-decimal-to-fractions +// Procedure adapted by forum user "circular": http://forum.lazarus.freepascal.org/index.php/topic,27805.msg172372.html#msg172372 +var + n: Integer; + lower_n, lower_d, upper_n, upper_d, middle_n, middle_d: Integer; + isNeg: Boolean; + backup_num, backup_denom: Integer; + newResult_num, newResult_denom: Integer; + EPS: Double; +begin + EPS := 0.01 / AMaxDenominator; + + isNeg := AValue < 0; + if isNeg then + AValue := -AValue; + + n := Trunc(AValue); + newResult_num := round(AValue); + newResult_denom := 1; + if isNeg then newResult_num := -newResult_num; + backup_num := newResult_num; + backup_denom := newResult_denom; + + AValue := AValue - n; + + // Lower fraction is 0/1 + lower_n := 0; + lower_d := 1; + + // Upper fraction is 1/1 + upper_n := 1; + upper_d := 1; + + while true do + begin + if abs(newResult_num/newResult_denom - n - AValue) < + abs(backup_num/backup_denom - n - AValue) + then begin + backup_num := newResult_num; + backup_denom := newResult_denom; + end; + + // middle fraction is (lower_n + upper_n) / (lower_d + upper_d) + middle_n := lower_n + upper_n; + middle_d := lower_d + upper_d; + newResult_num := n * middle_d + middle_n; + newResult_denom := middle_d; +// newResult.Normalize; + if (newResult_num > AMaxNumerator) or (newResult_denom > AMaxDenominator) + then begin + ANumerator := backup_num; + ADenominator := backup_denom; + exit; + end; + + if isNeg then newResult_num := -newResult_num; + + // AValue + EPS < middle + if middle_d * (AValue + EPS) < middle_n then + begin + // middle is our new upper + upper_n := middle_n; + upper_d := middle_d; + end else + // middle < AValue - EPS + if middle_n < (AValue - EPS) * middle_d then + begin + // middle is our new lower + lower_n := middle_n; + lower_d := middle_d; + end else + // middle is our best fraction + begin + ANumerator := newResult_num; + ADenominator := newResult_denom; + exit; + end; + end; +end; + {@@ ---------------------------------------------------------------------------- Creates a long date format string out of a short date format string. Retains the order of year-month-day and the separators, but uses 4 digits @@ -1722,6 +1842,64 @@ begin end; end; +{@@ ---------------------------------------------------------------------------- + Assumes that the specified text is a string representation of a mathematical + fraction and tries to extract the floating point value of this number. + Returns also the maximum count of digits used in the numerator or + denominator of the fraction + + @param AText String to be considered + @param ANumber (out) value of the converted floating point number + @param AMaxDigits Maximum count of digits used in the numerator or + denominator of the fraction + + @return TRUE if a number value can be retrieved successfully, FALSE otherwise + + @example AText := '1 3/4' --> ANumber = 1.75; AMaxDigits = 1; Result = true +-------------------------------------------------------------------------------} +function TryFractionStrToFloat(AText: String; out ANumber: Double; + out AMaxDigits: Integer): Boolean; +var + p: Integer; + s, sInt, sNum, sDenom: String; + i,num,denom: Integer; +begin + Result := false; + s := ''; + sInt := ''; + sNum := ''; + sDenom := ''; + + p := 1; + while p <= Length(AText) do begin + case AText[p] of + '0'..'9': s := s + AText[p]; + ' ': begin sInt := s; s := ''; end; + '/': begin sNum := s; s := ''; end; + else exit; + end; + inc(p); + end; + sDenom := s; + + if (sInt <> '') and not TryStrToInt(sInt, i) then + exit; + if (sNum = '') or not TryStrtoInt(sNum, num) then + exit; + if (sDenom = '') or not TryStrToInt(sDenom, denom) then + exit; + if denom = 0 then + exit; + + ANumber := num / denom; + if sInt <> '' then + ANumber := ANumber + i; + + AMaxDigits := Length(sDenom); + + Result := true; +end; + {@@ ---------------------------------------------------------------------------- Excel's unit of row heights is "twips", i.e. 1/20 point. Converts Twips to points. diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index 31438829e..51a22a971 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -623,7 +623,8 @@ begin AddFormat( 9, nfPercentage, '0%'); AddFormat(10, nfPercentage, '0.00%'); AddFormat(11, nfExp, '0.00E+00'); - // fraction formats 12 ('# ?/?') and 13 ('# ??/??') not supported + AddFormat(12, nfFraction, '# ?/?'); + AddFormat(13, nfFraction, '# ??/??'); AddFormat(14, nfShortDate, fs.ShortDateFormat); // 'M/D/YY' AddFormat(15, nfLongDate, fs.LongDateFormat); // 'D-MMM-YY' AddFormat(16, nfCustom, 'd/mmm'); // 'D-MMM' diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 344f752a2..402bb3db9 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -405,7 +405,8 @@ begin AddFormat( 9, nfPercentage, '0%'); AddFormat(10, nfPercentage, '0.00%'); AddFormat(11, nfExp, '0.00E+00'); - // fraction formats 12 ('# ?/?') and 13 ('# ??/??') not supported + AddFormat(12, nfFraction, '# ?/?'); + AddFormat(13, nfFraction, '# ??/??'); AddFormat(14, nfShortDate, fs.ShortDateFormat); // 'M/D/YY' AddFormat(15, nfLongDate, fs.LongDateFormat); // 'D-MMM-YY' AddFormat(16, nfCustom, 'd/mmm'); // 'D-MMM'