diff --git a/components/fpspreadsheet/examples/read_write/csvdemo/csvread.lpr b/components/fpspreadsheet/examples/read_write/csvdemo/csvread.lpr index 863fc9a82..2079d1b8a 100644 --- a/components/fpspreadsheet/examples/read_write/csvdemo/csvread.lpr +++ b/components/fpspreadsheet/examples/read_write/csvdemo/csvread.lpr @@ -4,12 +4,12 @@ csvread.dpr Demonstrates how to read a CSV file using the fpspreadsheet library } -program myexcel2read; +program csvread; {$mode delphi}{$H+} uses - Classes, SysUtils, LazUTF8, fpstypes, fpspreadsheet, fpscsv; + Classes, SysUtils, LazUTF8, fpstypes, fpsutils, fpspreadsheet, fpscsv; var MyWorkbook: TsWorkbook; @@ -35,29 +35,32 @@ begin // Create the spreadsheet MyWorkbook := TsWorkbook.Create; - MyWorkbook.Options := MyWorkbook.Options + [boReadFormulas]; - MyWorkbook.ReadFromFile(InputFilename, sfCSV); + try + MyWorkbook.Options := MyWorkbook.Options + [boReadFormulas]; + MyWorkbook.ReadFromFile(InputFilename, sfCSV); - MyWorksheet := MyWorkbook.GetFirstWorksheet; + MyWorksheet := MyWorkbook.GetFirstWorksheet; - // Write all cells with contents to the console - WriteLn(''); - WriteLn('Contents of the first worksheet of the file:'); - WriteLn(''); + // Write all cells with contents to the console + WriteLn(''); + WriteLn('Contents of the first worksheet of the file:'); + WriteLn(''); - for CurCell in MyWorksheet.Cells do - begin - if HasFormula(CurCell) then - WriteLn('Row: ', CurCell^.Row, ' Col: ', CurCell^.Col, ' Formula: ', MyWorksheet.ReadFormulaAsString(CurCell)) - else - WriteLn( - 'Row: ', CurCell^.Row, - ' Col: ', CurCell^.Col, - ' Value: ', UTF8ToConsole(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, CurCell^.Col)) - ); + for CurCell in MyWorksheet.Cells do + begin + if HasFormula(CurCell) then + WriteLn('Row: ', CurCell^.Row, ' Col: ', CurCell^.Col, ' Formula: ', MyWorksheet.ReadFormulaAsString(CurCell)) + else + WriteLn( + 'Row: ', CurCell^.Row, + ' Col: ', CurCell^.Col, + ' Value: ', UTF8ToConsole(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, CurCell^.Col)) + ); + end; + + finally + // Finalization + MyWorkbook.Free; end; - - // Finalization - MyWorkbook.Free; end. diff --git a/components/fpspreadsheet/examples/read_write/excel2demo/excel2read.lpr b/components/fpspreadsheet/examples/read_write/excel2demo/excel2read.lpr index 171948065..9e292d599 100644 --- a/components/fpspreadsheet/examples/read_write/excel2demo/excel2read.lpr +++ b/components/fpspreadsheet/examples/read_write/excel2demo/excel2read.lpr @@ -10,7 +10,7 @@ program excel2read; {$mode delphi}{$H+} uses - Classes, SysUtils, LazUTF8, fpsTypes, fpspreadsheet, xlsbiff2; + Classes, SysUtils, LazUTF8, fpsTypes, fpsUtils, fpspreadsheet, xlsbiff2; var MyWorkbook: TsWorkbook; @@ -33,28 +33,30 @@ begin // Create the spreadsheet MyWorkbook := TsWorkbook.Create; + try + MyWorkbook.Options := MyWorkbook.Options + [boReadFormulas, boAutoCalc]; + MyWorkbook.ReadFromFile(InputFilename, sfExcel2); - MyWorkbook.Options := MyWorkbook.Options + [boReadFormulas, boAutoCalc]; - MyWorkbook.ReadFromFile(InputFilename, sfExcel2); + MyWorksheet := MyWorkbook.GetFirstWorksheet; - MyWorksheet := MyWorkbook.GetFirstWorksheet; + // Write all cells with contents to the console + WriteLn(''); + WriteLn('Contents of the first worksheet of the file:'); + WriteLn(''); - // Write all cells with contents to the console - WriteLn(''); - WriteLn('Contents of the first worksheet of the file:'); - WriteLn(''); + for CurCell in MyWorksheet.Cells do + begin + Write('Row: ', CurCell^.Row, ' Col: ', CurCell^.Col, ' Value: ', + UTF8ToConsole(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, CurCell^.Col)) + ); + if HasFormula(CurCell) then + Write(' (Formula ', CurCell^.FormulaValue, ')'); + WriteLn; + end; - for CurCell in MyWorksheet.Cells do - begin - Write('Row: ', CurCell^.Row, ' Col: ', CurCell^.Col, ' Value: ', - UTF8ToConsole(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, CurCell^.Col)) - ); - if HasFormula(CurCell) then - Write(' (Formula ', CurCell^.FormulaValue, ')'); - WriteLn; + finally + // Finalization + MyWorkbook.Free; end; - - // Finalization - MyWorkbook.Free; end. diff --git a/components/fpspreadsheet/examples/read_write/excel5demo/excel5read.lpr b/components/fpspreadsheet/examples/read_write/excel5demo/excel5read.lpr index bf8431f50..6a8c30635 100644 --- a/components/fpspreadsheet/examples/read_write/excel5demo/excel5read.lpr +++ b/components/fpspreadsheet/examples/read_write/excel5demo/excel5read.lpr @@ -10,7 +10,7 @@ program excel5read; {$mode delphi}{$H+} uses - Classes, SysUtils, LazUTF8, fpsTypes, fpspreadsheet, xlsbiff5; + Classes, SysUtils, LazUTF8, fpsTypes, fpsUtils, fpspreadsheet, xlsbiff5; var MyWorkbook: TsWorkbook; @@ -31,27 +31,30 @@ begin // Create the spreadsheet MyWorkbook := TsWorkbook.Create; - MyWorkbook.Options := MyWorkbook.Options + [boReadFormulas]; - MyWorkbook.ReadFromFile(InputFilename, sfExcel5); + try + MyWorkbook.Options := MyWorkbook.Options + [boReadFormulas]; + MyWorkbook.ReadFromFile(InputFilename, sfExcel5); - MyWorksheet := MyWorkbook.GetFirstWorksheet; + MyWorksheet := MyWorkbook.GetFirstWorksheet; - // Write all cells with contents to the console - WriteLn(''); - WriteLn('Contents of the first worksheet of the file:'); - WriteLn(''); + // Write all cells with contents to the console + WriteLn(''); + WriteLn('Contents of the first worksheet of the file:'); + WriteLn(''); - for CurCell in MyWorksheet.Cells do - begin - Write('Row: ', CurCell^.Row, - ' Col: ', CurCell^.Col, ' Value: ', - UTF8ToConsole(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, CurCell^.Col))); - if HasFormula(CurCell) then - Write(' - Formula: ', CurCell^.FormulaValue); - WriteLn; + for CurCell in MyWorksheet.Cells do + begin + Write('Row: ', CurCell^.Row, + ' Col: ', CurCell^.Col, ' Value: ', + UTF8ToConsole(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, CurCell^.Col))); + if HasFormula(CurCell) then + Write(' - Formula: ', CurCell^.FormulaValue); + WriteLn; + end; + + finally + // Finalization + MyWorkbook.Free; end; - - // Finalization - MyWorkbook.Free; end. diff --git a/components/fpspreadsheet/examples/read_write/excel8demo/excel8read.lpr b/components/fpspreadsheet/examples/read_write/excel8demo/excel8read.lpr index e2d69033e..294677bf4 100644 --- a/components/fpspreadsheet/examples/read_write/excel8demo/excel8read.lpr +++ b/components/fpspreadsheet/examples/read_write/excel8demo/excel8read.lpr @@ -36,31 +36,32 @@ begin // Create the spreadsheet MyWorkbook := TsWorkbook.Create; - MyWorkbook.Options := MyWorkbook.Options + [boReadFormulas]; + try + MyWorkbook.Options := MyWorkbook.Options + [boReadFormulas]; + MyWorkbook.ReadFromFile(InputFilename, sfExcel8); + MyWorksheet := MyWorkbook.GetFirstWorksheet; - MyWorkbook.ReadFromFile(InputFilename, sfExcel8); + // Write all cells with contents to the console + WriteLn(''); + WriteLn('Contents of the first worksheet of the file:'); + WriteLn(''); - MyWorksheet := MyWorkbook.GetFirstWorksheet; + for CurCell in MyWorksheet.Cells do + begin + Write('Row: ', CurCell^.Row, + ' Col: ', CurCell^.Col, ' Value: ', + UTF8ToConsole(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, + CurCell^.Col)) + ); + if HasFormula(CurCell) then + WriteLn(' Formula: ', MyWorkSheet.ReadFormulaAsString(CurCell)) + else + WriteLn; + end; - // Write all cells with contents to the console - WriteLn(''); - WriteLn('Contents of the first worksheet of the file:'); - WriteLn(''); - - for CurCell in MyWorksheet.Cells do - begin - Write('Row: ', CurCell^.Row, - ' Col: ', CurCell^.Col, ' Value: ', - UTF8ToConsole(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, - CurCell^.Col)) - ); - if HasFormula(CurCell) then - WriteLn(' Formula: ', MyWorkSheet.ReadFormulaAsString(CurCell)) - else - WriteLn; + finally + // Finalization + MyWorkbook.Free; end; - - // Finalization - MyWorkbook.Free; end. diff --git a/components/fpspreadsheet/examples/visual/shared/sformatsettingsform.pas b/components/fpspreadsheet/examples/visual/shared/sformatsettingsform.pas index 27afb6999..5b464abf0 100644 --- a/components/fpspreadsheet/examples/visual/shared/sformatsettingsform.pas +++ b/components/fpspreadsheet/examples/visual/shared/sformatsettingsform.pas @@ -85,7 +85,7 @@ implementation {$R *.lfm} uses - fpsUtils, + fpsUtils, fpsNumFormat, sCurrencyForm; const diff --git a/components/fpspreadsheet/examples/visual/shared/snumformatform.pas b/components/fpspreadsheet/examples/visual/shared/snumformatform.pas index bac5b3419..9d38d8ec5 100644 --- a/components/fpspreadsheet/examples/visual/shared/snumformatform.pas +++ b/components/fpspreadsheet/examples/visual/shared/snumformatform.pas @@ -7,7 +7,7 @@ interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ButtonPanel, ExtCtrls, StdCtrls, Spin, Buttons, types, contnrs, inifiles, - fpsTypes, fpSpreadsheet; + fpsTypes, fpsNumFormat, fpSpreadsheet; type TsNumFormatCategory = (nfcNumber, nfcPercent, nfcScientific, nfcFraction, diff --git a/components/fpspreadsheet/fpscsv.pas b/components/fpspreadsheet/fpscsv.pas index 6b43714c6..699c4a6d4 100644 --- a/components/fpspreadsheet/fpscsv.pas +++ b/components/fpspreadsheet/fpscsv.pas @@ -96,7 +96,7 @@ implementation uses //StrUtils, DateUtils, LConvEncoding, Math, - fpsutils, fpscurrency; + fpsUtils, fpsCurrency, fpsNumFormat; { Initializes the FormatSettings of the CSVParams to default values which can be replaced by the FormatSettings of the workbook's FormatSettings } diff --git a/components/fpspreadsheet/fpsnumformat.pas b/components/fpspreadsheet/fpsnumformat.pas index 9f7c1eec9..d150bb893 100644 --- a/components/fpspreadsheet/fpsnumformat.pas +++ b/components/fpspreadsheet/fpsnumformat.pas @@ -11,7 +11,109 @@ uses fpstypes; type + {@@ Set of characters } + TsDecsChars = set of char; + + {@@ Tokens used by the elements of the number format parser } + TsNumFormatToken = ( + nftGeneral, // token for "general" number format + nftText, // must be quoted, stored in TextValue + nftThSep, // ',', replaced by FormatSettings.ThousandSeparator + nftDecSep, // '.', replaced by FormatSettings.DecimalSeparator + nftYear, // 'y' or 'Y', count stored in IntValue + nftMonth, // 'm' or 'M', count stored in IntValue + nftDay, // 'd' or 'D', count stored in IntValue + nftHour, // 'h' or 'H', count stored in IntValue + nftMinute, // 'n' or 'N' (or 'm'/'M'), count stored in IntValue + nftSecond, // 's' or 'S', count stored in IntValue + nftMilliseconds, // 'z', 'Z', '0', count stored in IntValue + nftAMPM, // + nftMonthMinute, // 'm'/'M' or 'n'/'N', meaning depending on context + nftDateTimeSep, // '/' or ':', replaced by value from FormatSettings, stored in TextValue + nftSign, // '+' or '-', stored in TextValue + nftSignBracket, // '(' or ')' for negative values, stored in TextValue + nftIntOptDigit, // '#', count stored in IntValue + nftIntZeroDigit, // '0', count stored in IntValue + nftIntSpaceDigit, // '?', count stored in IntValue + nftIntTh, // '#,##0' sequence for nfFixed, count of 0 stored in IntValue + nftZeroDecs, // '0' after dec sep, count stored in IntValue + nftOptDecs, // '#' after dec sep, count stored in IntValue + nftSpaceDecs, // '?' after dec sep, count stored in IntValue + nftExpChar, // 'e' or 'E', stored in TextValue + nftExpSign, // '+' or '-' in exponent + nftExpDigits, // '0' digits in exponent, count stored in IntValue + nftPercent, // '%' percent symbol + nftFactor, // thousand separators at end of format string, each one divides value by 1000 + nftFracSymbol, // '/' fraction symbol + nftFracNumOptDigit, // '#' in numerator, count stored in IntValue + nftFracNumSpaceDigit, // '?' in numerator, count stored in IntValue + nftFracNumZeroDigit, // '0' in numerator, count stored in IntValue + nftFracDenomOptDigit, // '#' in denominator, count stored in IntValue + nftFracDenomSpaceDigit,// '?' in denominator, count stored in IntValue + nftFracDenomZeroDigit, // '0' in denominator, count stored in IntValue + nftFracDenom, // specified denominator, value stored in IntValue + nftCurrSymbol, // e.g., '"$"', stored in TextValue + nftCountry, + nftColor, // e.g., '[red]', Color in IntValue + nftCompareOp, + nftCompareValue, + nftSpace, + nftEscaped, // '\' + nftRepeat, + nftEmptyCharWidth, + nftTextFormat); + + TsNumFormatElement = record + Token: TsNumFormatToken; + IntValue: Integer; + FloatValue: Double; + TextValue: String; + end; + + TsNumFormatElements = array of TsNumFormatElement; + + TsNumFormatKind = (nfkPercent, nfkExp, nfkCurrency, nfkFraction, + nfkDate, nfkTime, nfkTimeInterval, nfkHasColor, nfkHasThSep, nfkHasFactor); + TsNumFormatKinds = set of TsNumFormatKind; + + TsNumFormatSection = record + Elements: TsNumFormatElements; + Kind: TsNumFormatKinds; + NumFormat: TsNumberFormat; + Decimals: Byte; + Factor: Double; + FracInt: Integer; + FracNumerator: Integer; + FracDenominator: Integer; + CurrencySymbol: String; + Color: TsColor; + end; + PsNumFormatSection = ^TsNumFormatSection; + + TsNumFormatSections = array of TsNumFormatSection; + + { TsNumFormatParams } + TsNumFormatParams = class(TObject) + private + protected + function GetNumFormat: TsNumberFormat; virtual; + function GetNumFormatStr: String; virtual; + public + Sections: TsNumFormatSections; + procedure DeleteElement(ASectionIndex, AElementIndex: Integer); + procedure InsertElement(ASectionIndex, AElementIndex: Integer; + AToken: TsNumFormatToken); + function SectionsEqualTo(ASections: TsNumFormatSections): Boolean; + procedure SetCurrSymbol(AValue: String); + procedure SetDecimals(AValue: Byte); + procedure SetNegativeRed(AEnable: Boolean); + procedure SetThousandSep(AEnable: Boolean); + property NumFormat: TsNumberFormat read GetNumFormat; + property NumFormatStr: String read GetNumFormatStr; + end; + { TsNumFormatList } + TsNumFormatParamsClass = class of TsNumFormatParams; TsNumFormatList = class(TFPList) private @@ -32,13 +134,34 @@ type function Find(ASections: TsNumFormatSections): Integer; overload; function Find(AFormatstr: String): Integer; overload; property Items[AIndex: Integer]: TsNumFormatParams read GetItem write SetItem; default; - {@@ Workbook from which the number formats are collected in the list. It is - mainly needed to get access to the FormatSettings for easy localization of - some formatting strings. } -// property Workbook: TsWorkbook read FWorkbook; end; +{ Utility functions } + +function AddAMPM(const ATimeFormatString: String; + const AFormatSettings: TFormatSettings): String; +function AddIntervalBrackets(AFormatString: String): String; + +procedure BuildCurrencyFormatList(AList: TStrings; + APositive: Boolean; AValue: Double; const ACurrencySymbol: String); + +function BuildCurrencyFormatString(ANumberFormat: TsNumberFormat; + const AFormatSettings: TFormatSettings; ADecimals, APosCurrFmt, ANegCurrFmt: Integer; + ACurrencySymbol: String; Accounting: Boolean = false): 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; + +function BuildFormatStringFromSection(const ASection: TsNumFormatSection): String; + +function ConvertFloatToStr(AValue: Double; AParams: TsNumFormatParams; + AFormatSettings: TFormatSettings): String; +function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte; + function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean; overload; function IsCurrencyFormat(ANumFormat: TsNumFormatParams): Boolean; overload; @@ -55,12 +178,1163 @@ function IsLongTimeFormat(AFormatStr: String; ATimeSeparator: char): Boolean; ov function IsTimeIntervalFormat(ANumFormat: TsNumFormatParams): Boolean; +function MakeLongDateFormat(ADateFormat: String): String; +function MakeShortDateFormat(ADateFormat: String): String; +procedure MakeTimeIntervalMask(Src: String; var Dest: String); +function SpecialDateTimeFormat(ACode: String; + const AFormatSettings: TFormatSettings; ForWriting: Boolean): String; +function StripAMPM(const ATimeFormatString: String): String; + implementation uses + StrUtils, Math, fpsUtils, fpsNumFormatParser; +const + POS_CURR_FMT: array[0..3] of string = ( + // Format parameter 0 is "value", parameter 1 is "currency symbol" + ('%1:s%0:s'), // 0: $1 + ('%0:s%1:s'), // 1: 1$ + ('%1:s %0:s'), // 2: $ 1 + ('%0:s %1:s') // 3: 1 $ + ); + NEG_CURR_FMT: array[0..15] of string = ( + ('(%1:s%0:s)'), // 0: ($1) + ('-%1:s%0:s'), // 1: -$1 + ('%1:s-%0:s'), // 2: $-1 + ('%1:s%0:s-'), // 3: $1- + ('(%0:s%1:s)'), // 4: (1$) + ('-%0:s%1:s'), // 5: -1$ + ('%0:s-%1:s'), // 6: 1-$ + ('%0:s%1:s-'), // 7: 1$- + ('-%0:s %1:s'), // 8: -1 $ + ('-%1:s %0:s'), // 9: -$ 1 + ('%0:s %1:s-'), // 10: 1 $- + ('%1:s %0:s-'), // 11: $ 1- + ('%1:s -%0:s'), // 12: $ -1 + ('%0:s- %1:s'), // 13: 1- $ + ('(%1:s %0:s)'), // 14: ($ 1) + ('(%0:s %1:s)') // 15: (1 $) + ); + +{==============================================================================} +{ Float-to-string conversion } +{==============================================================================} + +type + TsNumFormatTokenSet = set of TsNumFormatToken; + +const + TERMINATING_TOKENS: TsNumFormatTokenSet = + [nftSpace, nftText, nftEscaped, nftPercent, nftCurrSymbol, nftSign, nftSignBracket]; + INT_TOKENS: TsNumFormatTokenSet = + [nftIntOptDigit, nftIntZeroDigit, nftIntSpaceDigit]; + DECS_TOKENS: TsNumFormatTokenSet = + [nftZeroDecs, nftOptDecs, nftSpaceDecs]; + FRACNUM_TOKENS: TsNumFormatTokenSet = + [nftFracNumOptDigit, nftFracNumZeroDigit, nftFracNumSpaceDigit]; + FRACDENOM_TOKENS: TsNumFormatTokenSet = + [nftFracDenomOptDigit, nftFracDenomZeroDigit, nftFracDenomSpaceDigit, nftFracDenom]; + EXP_TOKENS: TsNumFormatTokenSet = + [nftExpDigits]; // todo: expand by optional digits (0.00E+#) + +{ Helper function which checks whether a sequence of format tokens for + exponential formatting begins at the specified index in the format elements } +function CheckExp(const AElements: TsNumFormatElements; AIndex: Integer): Boolean; +var + numEl: Integer; + i: Integer; +begin + numEl := Length(AElements); + + Result := (AIndex < numEl) and (AElements[AIndex].Token in INT_TOKENS); + if not Result then + exit; + + numEl := Length(AElements); + i := AIndex + 1; + while (i < numEl) and (AElements[i].Token in INT_TOKENS) do inc(i); + + // no decimal places + if (i+2 < numEl) and + (AElements[i].Token = nftExpChar) and + (AElements[i+1].Token = nftExpSign) and + (AElements[i+2].Token in EXP_TOKENS) + then begin + Result := true; + exit; + end; + + // with decimal places + if (i < numEl) and (AElements[i].Token = nftDecSep) //and (AElements[i+1].Token in DECS_TOKENS) + then begin + inc(i); + while (i < numEl) and (AElements[i].Token in DECS_TOKENS) do inc(i); + if (i + 2 < numEl) and + (AElements[i].Token = nftExpChar) and + (AElements[i+1].Token = nftExpSign) and + (AElements[i+2].Token in EXP_TOKENS) + then begin + Result := true; + exit; + end; + end; + + Result := false; +end; + +{ Helper function which checks whether a sequence of format tokens for + fraction formatting begins at the specified index in the format elements } +function CheckFraction(const AElements: TsNumFormatElements; AIndex: Integer; + out digits: Integer): Boolean; +var + numEl: Integer; + i: Integer; +begin + digits := 0; + numEl := Length(AElements); + + Result := (AIndex < numEl); + if not Result then + exit; + + i := AIndex; + // Check for mixed fraction (integer split off, sample format "# ??/??" + if (AElements[i].Token in (INT_TOKENS + [nftIntTh])) then + begin + inc(i); + while (i < numEl) and (AElements[i].Token in (INT_TOKENS + [nftIntTh])) do inc(i); + while (i < numEl) and (AElements[i].Token in TERMINATING_TOKENS) do inc(i); + end; + + if (i = numEl) or not (AElements[i].Token in FRACNUM_TOKENS) then + exit(false); + + // Here follows the ordinary fraction (no integer split off); sample format "??/??" + while (i < numEl) and (AElements[i].Token in FRACNUM_TOKENS) do inc(i); + while (i < numEl) and (AElements[i].Token in TERMINATING_TOKENS) do inc(i); + if (i = numEl) or (AElements[i].Token <> nftFracSymbol) then + exit(False); + + inc(i); + while (i < numEl) and (AElements[i].Token in TERMINATING_TOKENS) do inc(i); + if (i = numEl) or (not (AElements[i].Token in FRACDENOM_TOKENS)) then + exit(false); + + while (i < numEL) and (AElements[i].Token in FRACDENOM_TOKENS) do + begin + case AElements[i].Token of + nftFracDenomZeroDigit : inc(digits, AElements[i].IntValue); + nftFracDenomSpaceDigit: inc(digits, AElements[i].IntValue); + nftFracDenomOptDigit : inc(digits, AElements[i].IntValue); + nftFracDenom : digits := -AElements[i].IntValue; // "-" indicates a literal denominator value! + end; + inc(i); + end; + Result := true; +end; + +{ Processes a sequence of #, 0, and ? tokens. + Adds leading (GrowRight=false) or trailing (GrowRight=true) zeros and/or + spaces as specified by the format elements to the number value string. + On exit AIndex points to the first non-integer token. } +function ProcessIntegerFormat(AValue: String; AFormatSettings: TFormatSettings; + const AElements: TsNumFormatElements; var AIndex: Integer; + ATokens: TsNumFormatTokenSet; GrowRight, UseThSep: Boolean): String; +const + OptTokens = [nftIntOptDigit, nftFracNumOptDigit, nftFracDenomOptDigit, nftOptDecs]; + ZeroTokens = [nftIntZeroDigit, nftFracNumZeroDigit, nftFracDenomZeroDigit, nftZeroDecs, nftIntTh]; + SpaceTokens = [nftIntSpaceDigit, nftFracNumSpaceDigit, nftFracDenomSpaceDigit, nftSpaceDecs]; + AllOptTokens = OptTokens + SpaceTokens; +var + fs: TFormatSettings absolute AFormatSettings; + i, j, L: Integer; + numEl: Integer; +begin + Result := AValue; + numEl := Length(AElements); + if GrowRight then + begin + // This branch is intended for decimal places, i.e. there may be trailing zeros. + i := AIndex; + if (AValue = '0') and (AElements[i].Token in AllOptTokens) then + Result := ''; + // Remove trailing zeros + while (Result <> '') and (Result[Length(Result)] = '0') + do Delete(Result, Length(Result), 1); + // Add trailing zeros or spaces as required by the elements. + i := AIndex; + L := 0; + while (i < numEl) and (AElements[i].Token in ATokens) do + begin + if AElements[i].Token in ZeroTokens then + begin + inc(L, AElements[i].IntValue); + while Length(Result) < L do Result := Result + '0' + end else + if AElements[i].Token in SpaceTokens then + begin + inc(L, AElements[i].IntValue); + while Length(Result) < L do Result := Result + ' '; + end; + inc(i); + end; + if UseThSep then begin + j := 2; + while (j < Length(Result)) and (Result[j-1] <> ' ') and (Result[j] <> ' ') do + begin + Insert(fs.ThousandSeparator, Result, 1); + inc(j, 3); + end; + end; + AIndex := i; + end else + begin + // This branch is intended for digits (or integer and numerator parts of fractions) + // --> There are no leading zeros. + // Find last digit token of the sequence + i := AIndex; + while (i < numEl) and (AElements[i].Token in ATokens) do + inc(i); + j := i; + if i > 0 then dec(i); + if (AValue = '0') and (AElements[i].Token in AllOptTokens) and (i = AIndex) then + Result := ''; + // From the end of the sequence, going backward, add leading zeros or spaces + // as required by the elements of the format. + L := 0; + while (i >= AIndex) do begin + if AElements[i].Token in ZeroTokens then + begin + inc(L, AElements[i].IntValue); + while Length(Result) < L do Result := '0' + Result; + end else + if AElements[i].Token in SpaceTokens then + begin + inc(L, AElements[i].IntValue); + while Length(Result) < L do Result := ' ' + Result; + end; + dec(i); + end; + AIndex := j; + if UseThSep then + begin + // AIndex := j + 1; + j := Length(Result) - 2; + while (j > 1) and (Result[j-1] <> ' ') and (Result[j] <> ' ') do + begin + Insert(fs.ThousandSeparator, Result, j); + dec(j, 3); + end; + end; + end; +end; + +{ Converts the floating point number to an exponential number string according + to the format specification in AElements. + It must have been verified before, that the elements in fact are valid for + an exponential format. } +function ProcessExpFormat(AValue: Double; AFormatSettings: TFormatSettings; + const AElements: TsNumFormatElements; var AIndex: Integer): String; +var + fs: TFormatSettings absolute AFormatSettings; + expchar: String; + expSign: String; + se, si, sd: String; + decs, expDigits: Integer; + intZeroDigits, intOptDigits, intSpaceDigits: Integer; + numStr: String; + i, id, p: Integer; + numEl: Integer; +begin + Result := ''; + numEl := Length(AElements); + + // Determine digits of integer part of mantissa + intZeroDigits := 0; + intOptDigits := 0; + intSpaceDigits := 0; + i := AIndex; + while (AElements[i].Token in INT_TOKENS) do begin + case AElements[i].Token of + nftIntZeroDigit : inc(intZeroDigits, AElements[i].IntValue); + nftIntSpaceDigit: inc(intSpaceDigits, AElements[i].IntValue); + nftIntOptDigit : inc(intOptDigits, AElements[i].IntValue); + end; + inc(i); + end; + + // No decimal places + if (i + 2 < numEl) and (AElements[i].Token = nftExpChar) then + begin + expChar := AElements[i].TextValue; + expSign := AElements[i+1].TextValue; + expDigits := 0; + i := i+2; + while (i < numEl) and (AElements[i].Token in EXP_TOKENS) do + begin + inc(expDigits, AElements[i].IntValue); // not exactly what Excel does... Rather exotic case... + inc(i); + end; + numstr := FormatFloat('0'+expChar+expSign+DupeString('0', expDigits), AValue, fs); + p := pos('e', Lowercase(numStr)); + se := copy(numStr, p, Length(numStr)); // exp part of the number string, incl "E" + numStr := copy(numstr, 1, p-1); // mantissa of the number string + numStr := ProcessIntegerFormat(numStr, fs, AElements, AIndex, INT_TOKENS, false, false); + Result := numStr + se; + AIndex := i; + end + else + // With decimal places + if (i + 1 < numEl) and (AElements[i].Token = nftDecSep) then + begin + inc(i); + id := i; // index of decimal elements + decs := 0; + while (i < numEl) and (AElements[i].Token in DECS_TOKENS) do + begin + case AElements[i].Token of + nftZeroDecs, + nftSpaceDecs: inc(decs, AElements[i].IntValue); + end; + inc(i); + end; + expChar := AElements[i].TextValue; + expSign := AElements[i+1].TextValue; + expDigits := 0; + inc(i, 2); + while (i < numEl) and (AElements[i].Token in EXP_TOKENS) do + begin + inc(expDigits, AElements[i].IntValue); + inc(i); + end; + if decs=0 then + numstr := FormatFloat('0'+expChar+expSign+DupeString('0', expDigits), AValue, fs) + else + numStr := FloatToStrF(AValue, ffExponent, decs+1, expDigits, fs); + if (abs(AValue) >= 1.0) and (expSign = '-') then + Delete(numStr, pos('+', numStr), 1); + p := pos('e', Lowercase(numStr)); + se := copy(numStr, p, Length(numStr)); // exp part of the number string, incl "E" + numStr := copy(numStr, 1, p-1); // mantissa of the number string + p := pos(fs.DecimalSeparator, numStr); + if p = 0 then + begin + si := numstr; + sd := ''; + end else + begin + si := ProcessIntegerFormat(copy(numStr, 1, p-1), fs, AElements, AIndex, INT_TOKENS, false, false); // integer part of the mantissa + sd := ProcessIntegerFormat(copy(numStr, p+1, Length(numStr)), fs, AElements, id, DECS_TOKENS, true, false); // fractional part of the mantissa + end; + // Put all parts together... + Result := si + fs.DecimalSeparator + sd + se; + AIndex := i; + end; +end; + +function ProcessFracFormat(AValue: Double; const AFormatSettings: TFormatSettings; + ADigits: Integer; const AElements: TsNumFormatElements; + var AIndex: Integer): String; +var + fs: TFormatSettings absolute AFormatSettings; + frint, frnum, frdenom, maxdenom: Int64; + sfrint, sfrnum, sfrdenom: String; + sfrsym, sintnumspace, snumsymspace, ssymdenomspace: String; + i, numEl: Integer; +begin + sintnumspace := ''; + snumsymspace := ''; + ssymdenomspace := ''; + sfrsym := '/'; + if ADigits >= 0 then + maxDenom := Round(IntPower(10, ADigits)); + numEl := Length(AElements); + + i := AIndex; + if AElements[i].Token in (INT_TOKENS + [nftIntTh]) then begin + // Split-off integer + if (AValue >= 1) then + begin + frint := trunc(AValue); + AValue := frac(AValue); + end else + frint := 0; + if ADigits >= 0 then + FloatToFraction(AValue, maxdenom, frnum, frdenom) + else + begin + frdenom := -ADigits; + frnum := round(AValue*frdenom); + end; + sfrint := ProcessIntegerFormat(IntToStr(frint), fs, AElements, i, + INT_TOKENS + [nftIntTh], false, (AElements[i].Token = nftIntTh)); + while (i < numEl) and (AElements[i].Token in TERMINATING_TOKENS) do + begin + sintnumspace := sintnumspace + AElements[i].TextValue; + inc(i); + end; + end else + begin + // "normal" fraction + sfrint := ''; + if ADigits > 0 then + FloatToFraction(AValue, maxdenom, frnum, frdenom) + else + begin + frdenom := -ADigits; + frnum := round(AValue*frdenom); + end; + sintnumspace := ''; + end; + + // numerator and denominator + sfrnum := ProcessIntegerFormat(IntToStr(frnum), fs, AElements, i, + FRACNUM_TOKENS, false, false); + while (i < numEl) and (AElements[i].Token in TERMINATING_TOKENS) do + begin + snumsymspace := snumsymspace + AElements[i].TextValue; + inc(i); + end; + inc(i); // fraction symbol + while (i < numEl) and (AElements[i].Token in TERMINATING_TOKENS) do + begin + ssymdenomspace := ssymdenomspace + AElements[i].TextValue; + inc(i); + end; + + sfrdenom := ProcessIntegerFormat(IntToStr(frdenom), fs, AElements, i, + FRACDENOM_TOKENS, false, false); + AIndex := i+1; + + // Special cases + if (frnum = 0) then + begin + if sfrnum = '' then begin + sintnumspace := ''; + snumsymspace := ''; + ssymdenomspace := ''; + sfrdenom := ''; + sfrsym := ''; + end else + if trim(sfrnum) = '' then begin + sfrdenom := DupeString(' ', Length(sfrdenom)); + sfrsym := ' '; + end; + end; + if sfrint = '' then sintnumspace := ''; + + // Compose result string + Result := sfrnum + snumsymspace + sfrsym + ssymdenomspace + sfrdenom; + if (Trim(Result) = '') and (sfrint = '') then + sfrint := '0'; + if sfrint <> '' then + Result := sfrint + sintnumSpace + result; +end; + +function ProcessFloatFormat(AValue: Double; AFormatSettings: TFormatSettings; + const AElements: TsNumFormatElements; var AIndex: Integer): String; +var + fs: TFormatSettings absolute AFormatSettings; + numEl: Integer; + numStr, s: String; + p, i: Integer; + decs: Integer; + useThSep: Boolean; +begin + Result := ''; + numEl := Length(AElements); + + // Extract integer part + Result := IntToStr(trunc(AValue)); + useThSep := AElements[AIndex].Token = nftIntTh; + Result := ProcessIntegerFormat(Result, fs, AElements, AIndex, + (INT_TOKENS + [nftIntTh]), false, UseThSep); + + // Decimals + if (AIndex < numEl) and (AElements[AIndex].Token = nftDecSep) then + begin + inc(AIndex); + i := AIndex; + // Count decimal digits in format elements + decs := 0; + while (AIndex < numEl) and (AElements[AIndex].Token in DECS_TOKENS) do begin + inc(decs, AElements[AIndex].IntValue); + inc(AIndex); + end; + // Convert value to string + numstr := FloatToStrF(AValue, ffFixed, MaxInt, decs, fs); + p := Pos(fs.DecimalSeparator, numstr); + s := Copy(numstr, p+1, Length(numstr)); + s := ProcessIntegerFormat(s, fs, AElements, i, DECS_TOKENS, true, false); + if s <> '' then + Result := Result + fs.DecimalSeparator + s; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Converts a floating point number to a string as determined by the specified + number format parameters + + @param AValue Value to be converted to a string + @param AParams Number format params which will be applied in the + conversion. The number format params are obtained + by the number format parser from the number format + string. + @param AFormatSettings Format settings needed by the number format parser for + the conversion + @return Converted string +-------------------------------------------------------------------------------} +function ConvertFloatToStr(AValue: Double; AParams: TsNumFormatParams; + AFormatSettings: TFormatSettings): String; +var + fs: TFormatSettings absolute AFormatSettings; + sidx: Integer; + section: TsNumFormatSection; + i, el, numEl: Integer; + isNeg: Boolean; + yr, mon, day, hr, min, sec, ms: Word; + s: String; + digits: Integer; +begin + Result := ''; + if IsNaN(AValue) then + exit; + + if AParams = nil then + begin + Result := FloatToStrF(AValue, ffGeneral, 20, 20, fs); + exit; + end; + + sidx := 0; + if (AValue < 0) and (Length(AParams.Sections) > 1) then + sidx := 1; + if (AValue = 0) and (Length(AParams.Sections) > 2) then + sidx := 2; + isNeg := (AValue < 0); + AValue := abs(AValue); // section 0 adds the sign back, section 1 has the sign in the elements + section := AParams.Sections[sidx]; + numEl := Length(section.Elements); + + if nfkPercent in section.Kind then + AValue := AValue * 100.0; + if nfkHasFactor in section.Kind then + AValue := AValue * section.Factor; + if nfkTime in section.Kind then + DecodeTime(AValue, hr, min, sec, ms); + if nfkDate in section.Kind then + DecodeDate(AValue, yr, mon, day); + + el := 0; + while (el < numEl) do begin + if section.Elements[el].Token = nftGeneral then + begin + s := FloatToStrF(AValue, ffGeneral, 20, 20, fs); + if (sidx=0) and isNeg then s := '-' + s; + Result := Result + s; + end + else + // Integer token: can be the start of a number, exp, or mixed fraction format + // Cases with thousand separator are handled here as well. + if section.Elements[el].Token in (INT_TOKENS + [nftIntTh]) then begin + // Check for exponential format + if CheckExp(section.Elements, el) then + s := ProcessExpFormat(AValue, fs, section.Elements, el) + else + // Check for fraction format + if CheckFraction(section.Elements, el, digits) then + s := ProcessFracFormat(AValue, fs, digits, section.Elements, el) + else + // Floating-point or integer + s := ProcessFloatFormat(AValue, fs, section.Elements, el); + if (sidx = 0) and isNeg then s := '-' + s; + Result := Result + s; + Continue; + end + else + // Regular fraction (without integer being split off) + if (section.Elements[el].Token in FRACNUM_TOKENS) and + CheckFraction(section.Elements, el, digits) then + begin + s := ProcessFracFormat(AValue, fs, digits, section.Elements, el); + if (sidx = 0) and isNeg then s := '-' + s; + Result := Result + s; + Continue; + end + else + case section.Elements[el].Token of + nftSpace, nftText, nftEscaped, nftCurrSymbol, + nftSign, nftSignBracket, nftPercent: + Result := Result + section.Elements[el].TextValue; + + nftEmptyCharWidth: + Result := Result + ' '; + + nftDateTimeSep: + case section.Elements[el].TextValue of + '/': Result := Result + fs.DateSeparator; + ':': Result := Result + fs.TimeSeparator; + else Result := Result + section.Elements[el].TextValue; + end; + + nftDecSep: + Result := Result + fs.DecimalSeparator; + + nftThSep: + Result := Result + fs.ThousandSeparator; + + nftYear: + case section.Elements[el].IntValue of + 1, + 2: Result := Result + IfThen(yr mod 100 < 10, '0'+IntToStr(yr mod 100), IntToStr(yr mod 100)); + 4: Result := Result + IntToStr(yr); + end; + + nftMonth: + case section.Elements[el].IntValue of + 1: Result := Result + IntToStr(mon); + 2: Result := Result + IfThen(mon < 10, '0'+IntToStr(mon), IntToStr(mon)); + 3: Result := Result + fs.ShortMonthNames[mon]; + 4: Result := Result + fs.LongMonthNames[mon]; + end; + + nftDay: + case section.Elements[el].IntValue of + 1: result := result + IntToStr(day); + 2: result := Result + IfThen(day < 10, '0'+IntToStr(day), IntToStr(day)); + 3: Result := Result + fs.ShortDayNames[DayOfWeek(day)]; + 4: Result := Result + fs.LongDayNames[DayOfWeek(day)]; + end; + + nftHour: + begin + if section.Elements[el].IntValue < 0 then // This case is for nfTimeInterval + s := IntToStr(Int64(hr) + trunc(AValue) * 24) + else + if section.Elements[el].TextValue = 'AM' then // This tag is set in case of AM/FM format + begin + hr := hr mod 12; + if hr = 0 then hr := 12; + s := IntToStr(hr) + end else + s := IntToStr(hr); + if (abs(section.Elements[el].IntValue) = 2) and (Length(s) = 1) then + s := '0' + s; + Result := Result + s; + end; + + nftMinute: + begin + if section.Elements[el].IntValue < 0 then // case for nfTimeInterval + s := IntToStr(int64(min) + trunc(AValue) * 24 * 60) + else + s := IntToStr(min); + if (abs(section.Elements[el].IntValue) = 2) and (Length(s) = 1) then + s := '0' + s; + Result := Result + s; + end; + + nftSecond: + begin + if section.Elements[el].IntValue < 0 then // case for nfTimeInterval + s := IntToStr(Int64(sec) + trunc(AValue) * 24 * 60 * 60) + else + s := IntToStr(sec); + if (abs(section.Elements[el].IntValue) = 2) and (Length(s) = 1) then + s := '0' + s; + Result := Result + s; + end; + + nftMilliseconds: + case section.Elements[el].IntValue of + 1: Result := Result + IntToStr(ms div 100); + 2: Result := Result + Format('%02d', [ms div 10]); + 3: Result := Result + Format('%03d', [ms]); + end; + + nftAMPM: + begin + s := section.Elements[el].TextValue; + if lowercase(s) = 'ampm' then + s := IfThen(frac(AValue) < 0.5, fs.TimeAMString, fs.TimePMString) + else + begin + i := pos('/', s); + if i > 0 then + s := IfThen(frac(AValue) < 0.5, copy(s, 1, i-1), copy(s, i+1, Length(s))) + else + s := IfThen(frac(AValue) < 0.5, 'AM', 'PM'); + end; + Result := Result + s; + end; + end; // case + inc(el); + end; // while +end; + + +{==============================================================================} +{ Utility functions } +{==============================================================================} + +{@@ ---------------------------------------------------------------------------- + Adds an AM/PM format code to a pre-built time formatting string. The strings + replacing "AM" or "PM" in the final formatted number are taken from the + TimeAMString or TimePMString of the given FormatSettings. + + @param ATimeFormatString String of time formatting codes (such as 'hh:nn') + @param AFormatSettings FormatSettings for locale-dependent information + @result Formatting string with AM/PM option activated. + + Example: ATimeFormatString = 'hh:nn' ==> 'hh:nn AM/PM' +-------------------------------------------------------------------------------} +function AddAMPM(const ATimeFormatString: String; + const AFormatSettings: TFormatSettings): String; +var + am, pm: String; + fs: TFormatSettings absolute AFormatSettings; +begin + am := IfThen(fs.TimeAMString <> '', fs.TimeAMString, 'AM'); + pm := IfThen(fs.TimePMString <> '', fs.TimePMString, 'PM'); + Result := Format('%s %s/%s', [StripAMPM(ATimeFormatString), am, pm]); +end; + +{@@ ---------------------------------------------------------------------------- + The given format string is assumed to represent a time interval, i.e. its + first time symbol must be enclosed by square brackets. Checks if this is true, + and adds the brackes if not. + + @param AFormatString String with time formatting codes + @return Unchanged format string if its first time code is in square brackets + (as in '[h]:nn:ss'), if not, the first time code is enclosed in + square brackets. +-------------------------------------------------------------------------------} +function AddIntervalBrackets(AFormatString: String): String; +var + p: Integer; + s1, s2: String; +begin + if AFormatString[1] = '[' then + Result := AFormatString + else begin + p := pos(':', AFormatString); + if p <> 0 then begin + s1 := copy(AFormatString, 1, p-1); + s2 := copy(AFormatString, p, Length(AFormatString)); + Result := Format('[%s]%s', [s1, s2]); + end else + Result := Format('[%s]', [AFormatString]); + end; +end; + +{@@ ---------------------------------------------------------------------------- + Builds a string list with samples of the predefined currency formats + + @param AList String list in which the format samples are stored + @param APositive If true, samples are built for positive currency + values, otherwise for negative values + @param AValue Currency value to be used when calculating the sample + strings + @param ACurrencySymbol Currency symbol string to be used in the samples +-------------------------------------------------------------------------------} +procedure BuildCurrencyFormatList(AList: TStrings; + APositive: Boolean; AValue: Double; const ACurrencySymbol: String); +var + valueStr: String; + i: Integer; +begin + valueStr := Format('%.0n', [AValue]); + AList.BeginUpdate; + try + if AList.Count = 0 then + begin + if APositive then + for i:=0 to High(POS_CURR_FMT) do + AList.Add(Format(POS_CURR_FMT[i], [valueStr, ACurrencySymbol])) + else + for i:=0 to High(NEG_CURR_FMT) do + AList.Add(Format(NEG_CURR_FMT[i], [valueStr, ACurrencySymbol])); + end else + begin + if APositive then + for i:=0 to High(POS_CURR_FMT) do + AList[i] := Format(POS_CURR_FMT[i], [valueStr, ACurrencySymbol]) + else + for i:=0 to High(NEG_CURR_FMT) do + AList[i] := Format(NEG_CURR_FMT[i], [valueStr, ACurrencySymbol]); + end; + finally + AList.EndUpdate; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Builds a currency format string. The presentation of negative values (brackets, + or minus signs) is taken from the provided format settings. The format string + consists of three sections, separated by semicolons. + + @param ANumberFormat Identifier of the built-in number format for which the + format string is to be generated. + @param AFormatSettings FormatSettings to be applied (used to extract default + values for the next parameters) + @param ADecimals number of decimal places. If < 0, the CurrencyDecimals + of the FormatSettings is used. + @param APosCurrFmt Identifier for the order of currency symbol, value and + spaces of positive values + - see pcfXXXX constants in fpspreadsheet.pas. + If < 0, the CurrencyFormat of the FormatSettings is used. + @param ANegCurrFmt Identifier for the order of currency symbol, value and + spaces of negative values. Specifies also usage of (). + - see ncfXXXX constants in fpspreadsheet.pas. + If < 0, the NegCurrFormat of the FormatSettings is used. + @param ACurrencySymbol Name of the currency, like $ or USD. + If ? the CurrencyString of the FormatSettings is used. + @param Accounting If true, adds spaces for alignment of decimals + + @return String of formatting codes, such as '"$"#,##0.00;("$"#,##0.00);"$"0.00' +-------------------------------------------------------------------------------} +function BuildCurrencyFormatString(ANumberFormat: TsNumberFormat; + const AFormatSettings: TFormatSettings; + ADecimals, APosCurrFmt, ANegCurrFmt: Integer; ACurrencySymbol: String; + Accounting: Boolean = false): String; +var + decs: String; + pcf, ncf: Byte; + p, n: String; + negRed: Boolean; +begin + pcf := IfThen(APosCurrFmt < 0, AFormatSettings.CurrencyFormat, APosCurrFmt); + ncf := IfThen(ANegCurrFmt < 0, AFormatSettings.NegCurrFormat, ANegCurrFmt); + if (ADecimals < 0) then + ADecimals := AFormatSettings.CurrencyDecimals; + if ACurrencySymbol = '?' then + ACurrencySymbol := AFormatSettings.CurrencyString; + if ACurrencySymbol <> '' then + ACurrencySymbol := '"' + ACurrencySymbol + '"'; + decs := DupeString('0', ADecimals); + if ADecimals > 0 then decs := '.' + decs; + + negRed := (ANumberFormat = nfCurrencyRed); + p := POS_CURR_FMT[pcf]; // Format mask for positive values + n := NEG_CURR_FMT[ncf]; // Format mask for negative values + + // add extra space for the sign of the number for perfect alignment in Excel + if Accounting then + case ncf of + 0, 14: p := p + '_)'; + 3, 11: p := p + '_-'; + 4, 15: p := '_(' + p; + 5, 8 : p := '_-' + p; + end; + + if ACurrencySymbol <> '' then begin + Result := Format(p, ['#,##0' + decs, ACurrencySymbol]) + ';' + + IfThen(negRed, '[red]', '') + + Format(n, ['#,##0' + decs, ACurrencySymbol]) + ';' + + Format(p, ['0'+decs, ACurrencySymbol]); + end + else begin + Result := '#,##0' + decs; + if negRed then + Result := Result +';[red]' + else + Result := Result +';'; + case ncf of + 0, 14, 15 : Result := Result + '(#,##0' + decs + ')'; + 1, 2, 5, 6, 8, 9, 12: Result := Result + '-#,##0' + decs; + else Result := Result + '#,##0' + decs + '-'; + end; + Result := Result + ';0' + decs; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Builds a date/time format string from the number format code. + + @param ANumberFormat built-in number format identifier + @param AFormatSettings Format settings from which locale-dependent + information like day-month-year order is taken. + @param AFormatString Optional pre-built formatting string. It is used + only for the format nfInterval where square brackets + are added to the first time code field. + @return String of date/time formatting code constructed from the built-in + format information. +-------------------------------------------------------------------------------} +function BuildDateTimeFormatString(ANumberFormat: TsNumberFormat; + const AFormatSettings: TFormatSettings; AFormatString: String = '') : string; +var + i, j: Integer; + Unwanted: set of ansichar; +begin + case ANumberFormat of + nfShortDateTime: + Result := AFormatSettings.ShortDateFormat + ' ' + AFormatSettings.ShortTimeFormat; + // In the DefaultFormatSettings this is: d/m/y hh:nn + nfShortDate: + Result := AFormatSettings.ShortDateFormat; // --> d/m/y + nfLongDate: + Result := AFormatSettings.LongDateFormat; // --> dd mm yyyy + nfShortTime: + Result := StripAMPM(AFormatSettings.ShortTimeFormat); // --> hh:nn + nfLongTime: + Result := StripAMPM(AFormatSettings.LongTimeFormat); // --> hh:nn:ss + nfShortTimeAM: + begin // --> hh:nn AM/PM + Result := AFormatSettings.ShortTimeFormat; + if (pos('a', lowercase(AFormatSettings.ShortTimeFormat)) = 0) then + Result := AddAMPM(Result, AFormatSettings); + end; + nfLongTimeAM: // --> hh:nn:ss AM/PM + begin + Result := AFormatSettings.LongTimeFormat; + if pos('a', lowercase(AFormatSettings.LongTimeFormat)) = 0 then + Result := AddAMPM(Result, AFormatSettings); + end; + nfDayMonth, // --> dd/mmm + nfMonthYear: // --> mmm/yy + begin + Result := AFormatSettings.ShortDateFormat; + case ANumberFormat of + nfDayMonth: + unwanted := ['y', 'Y']; + nfMonthYear: + unwanted := ['d', 'D']; + end; + for i:=Length(Result) downto 1 do + if Result[i] in unwanted then Delete(Result, i, 1); + while not (Result[1] in (['m', 'M', 'd', 'D', 'y', 'Y'] - unwanted)) do + Delete(Result, 1, 1); + while not (Result[Length(Result)] in (['m', 'M', 'd', 'D', 'y', 'Y'] - unwanted)) do + Delete(Result, Length(Result), 1); + i := 1; + while not (Result[i] in ['m', 'M']) do inc(i); + j := i; + while (j <= Length(Result)) and (Result[j] in ['m', 'M']) do inc(j); + while (j - i < 3) do begin + Insert(Result[i], Result, j); + inc(j); + end; + end; + nfTimeInterval: // --> [h]:nn:ss + if AFormatString = '' then + Result := '[h]:nn:ss' + else + Result := AddIntervalBrackets(AFormatString); + 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 + if ADenominatorDigits < 0 then // a negative value indicates a fixed denominator value + Result := Format('%s/%d', [ + DupeString('?', ANumeratorDigits), -ADenominatorDigits + ]) + else + 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. + + @param ANumberFormat Identifier of the built-in numberformat for which a + format string is to be generated + @param AFormatSettings FormatSettings for default parameters + @param ADecimals Number of decimal places. If < 0 the CurrencyDecimals + value of the FormatSettings is used. In case of a + fraction format "ADecimals" refers to the maximum count + digits of the denominator. + + @return String of formatting codes + + @example ANumberFormat = nfFixedTh, ADecimals = 2 --> '#,##0.00' +-------------------------------------------------------------------------------} +function BuildNumberFormatString(ANumberFormat: TsNumberFormat; + const AFormatSettings: TFormatSettings; ADecimals: Integer = -1): String; +var + decs: String; +begin + Result := ''; + if ADecimals = -1 then + ADecimals := AFormatSettings.CurrencyDecimals; + decs := DupeString('0', ADecimals); + if ADecimals > 0 then decs := '.' + decs; + case ANumberFormat of + nfFixed: + Result := '0' + decs; + nfFixedTh: + Result := '#,##0' + decs; + nfExp: + Result := '0' + decs + 'E+00'; + nfPercentage: + Result := '0' + decs + '%'; + nfFraction: + if ADecimals = 0 then // "ADecimals" has a different meaning here... + Result := '# ??/??' // This is the default fraction format + else + begin + decs := DupeString('?', ADecimals); + Result := '# ' + decs + '/' + decs; + end; + nfCurrency, nfCurrencyRed: + Result := BuildCurrencyFormatString(ANumberFormat, AFormatSettings, + ADecimals, AFormatSettings.CurrencyFormat, AFormatSettings.NegCurrFormat, + AFormatSettings.CurrencyString); + nfShortDateTime, nfShortDate, nfLongDate, nfShortTime, nfLongTime, + nfShortTimeAM, nfLongTimeAM, nfDayMonth, nfMonthYear, nfTimeInterval: + raise Exception.Create('BuildNumberFormatString: Use BuildDateTimeFormatSstring '+ + 'to create a format string for date/time values.'); + end; +end; + +{ Creates a format string for the given number format section section. + The format string is created according to Excel convention (which is used by + ODS as well } +function BuildFormatStringFromSection(const ASection: TsNumFormatSection): String; +var + element: TsNumFormatElement; + i, n: Integer; +begin + Result := ''; + + for i := 0 to High(ASection.Elements) do begin + element := ASection.Elements[i]; + case element.Token of + nftGeneral: + Result := Result + 'General'; + nftIntOptDigit, nftOptDecs, nftFracNumOptDigit, nftFracDenomOptDigit: + if element.IntValue > 0 then + Result := Result + DupeString('#', element.IntValue); + nftIntZeroDigit, nftZeroDecs, nftFracNumZeroDigit, nftFracDenomZeroDigit, nftExpDigits: + if element.IntValue > 0 then + Result := result + DupeString('0', element.IntValue); + nftIntSpaceDigit, nftSpaceDecs, nftFracNumSpaceDigit, nftFracDenomSpaceDigit: + if element.Intvalue > 0 then + Result := result + DupeString('?', element.IntValue); + nftFracDenom: + Result := Result + IntToStr(element.IntValue); + nftIntTh: + case element.Intvalue of + 0: Result := Result + '#,###'; + 1: Result := Result + '#,##0'; + 2: Result := Result + '#,#00'; + 3: Result := Result + '#,000'; + end; + nftDecSep, nftThSep: + Result := Result + element.TextValue; + nftFracSymbol: + Result := Result + '/'; + nftPercent: + Result := Result + '%'; + nftFactor: + if element.IntValue <> 0 then + begin + n := element.IntValue; + while (n > 0) do + begin + Result := Result + element.TextValue; + dec(n); + end; + end; + nftSpace: + Result := Result + ' '; + nftText: + if element.TextValue <> '' then result := Result + '"' + element.TextValue + '"'; + nftYear: + Result := Result + DupeString('Y', element.IntValue); + nftMonth: + Result := Result + DupeString('M', element.IntValue); + nftDay: + Result := Result + DupeString('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('m', -element.IntValue) + ']' + else Result := Result + DupeString('m', element.IntValue); + nftSecond: + if element.IntValue < 0 + then Result := Result + '[' + DupeString('s', -element.IntValue) + ']' + else Result := Result + DupeString('s', element.IntValue); + nftMilliseconds: + Result := Result + DupeString('0', element.IntValue); + nftSign, nftSignBracket, nftExpChar, nftExpSign, nftAMPM, nftDateTimeSep: + if element.TextValue <> '' then Result := Result + element.TextValue; + nftCurrSymbol: + if element.TextValue <> '' then + Result := Result + '[$' + element.TextValue + ']'; + nftEscaped: + if element.TextValue <> '' then + Result := Result + '\' + element.TextValue; + nftTextFormat: + if element.TextValue <> '' then + Result := Result + element.TextValue; + nftRepeat: + if element.TextValue <> '' then Result := Result + '*' + element.TextValue; + nftColor: + 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; + +{@@ ---------------------------------------------------------------------------- + Counts how many decimal places are coded into a given formatting string. + + @param AFormatString String with number format codes, such as '0.000' + @param ADecChars Characters which are considered as symbols for decimals. + For the fixed decimals, this is the '0'. Optional + decimals are encoced as '#'. + @return Count of decimal places found (3 in above example). +-------------------------------------------------------------------------------} +function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte; +var + i: Integer; +begin + Result := 0; + 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; +end; + {@@ ---------------------------------------------------------------------------- Checks whether the given number format code is for currency, i.e. requires currency symbol. @@ -215,11 +1489,424 @@ begin (ANumFormat.Sections[0].Kind * [nfkTimeInterval] <> []); 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 + for year and 3 digits of month. -{ -----------------------------------------------------------------------------} + @param ADateFormat String with date formatting code representing a + "short" date, such as 'dd/mm/yy' + @return Format string modified to represent a "long" date, such as 'dd/mmm/yyyy' +-------------------------------------------------------------------------------} +function MakeLongDateFormat(ADateFormat: String): String; +var + i: Integer; +begin + Result := ''; + i := 1; + while i < Length(ADateFormat) do begin + case ADateFormat[i] of + 'y', 'Y': + begin + Result := Result + DupeString(ADateFormat[i], 4); + while (i < Length(ADateFormat)) and (ADateFormat[i] in ['y','Y']) do + inc(i); + end; + 'm', 'M': + begin + result := Result + DupeString(ADateFormat[i], 3); + while (i < Length(ADateFormat)) and (ADateFormat[i] in ['m','M']) do + inc(i); + end; + else + Result := Result + ADateFormat[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. + + @param ADateFormat String with date formatting codes representing a + "long" date, such as 'dd/mmm/yyyy' + @return Format string modified to represent a "short" date, such as 'dd/mm/yy' +-------------------------------------------------------------------------------} +function MakeShortDateFormat(ADateFormat: String): String; +var + i: Integer; +begin + Result := ''; + i := 1; + while i < Length(ADateFormat) do begin + case ADateFormat[i] of + 'y', 'Y': + begin + Result := Result + DupeString(ADateFormat[i], 2); + while (i < Length(ADateFormat)) and (ADateFormat[i] in ['y','Y']) do + inc(i); + end; + 'm', 'M': + begin + result := Result + DupeString(ADateFormat[i], 2); + while (i < Length(ADateFormat)) and (ADateFormat[i] in ['m','M']) do + inc(i); + end; + else + Result := Result + ADateFormat[i]; + inc(i); + end; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Creates a "time interval" format string having the first time code identifier + in square brackets. + + @param Src Source format string, must be a time format string, like 'hh:nn' + @param Dest Destination format string, will have the first time code element + of the src format string in square brackets, like '[hh]:nn'. +-------------------------------------------------------------------------------} +procedure MakeTimeIntervalMask(Src: String; var Dest: String); +var + L: TStrings; +begin + L := TStringList.Create; + try + L.StrictDelimiter := true; + L.Delimiter := ':'; + L.DelimitedText := Src; + if L[0][1] <> '[' then L[0] := '[' + L[0]; + if L[0][Length(L[0])] <> ']' then L[0] := L[0] + ']'; + Dest := L.DelimitedText; + finally + L.Free; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Creates the formatstrings for the date/time codes "dm", "my", "ms" and "msz" + out of the formatsettings. + + @param ACode Quick formatting code for parts of date/time number formats; + "dm" = day + month + "my" = month + year + "ms" = minutes + seconds + "msz" = minutes + seconds + fractions of a second + @return String of formatting codes according to the parameter ACode +-------------------------------------------------------------------------------} +function SpecialDateTimeFormat(ACode: String; + const AFormatSettings: TFormatSettings; ForWriting: Boolean): String; +var + pd, pm, py: Integer; + sdf: String; + MonthChar, MinuteChar, MillisecChar: Char; +begin + if ForWriting then begin + MonthChar := 'M'; MinuteChar := 'm'; MillisecChar := '0'; + end else begin + MonthChar := 'm'; MinuteChar := 'n'; MillisecChar := 'z'; + end; + ACode := lowercase(ACode); + sdf := lowercase(AFormatSettings.ShortDateFormat); + pd := pos('d', sdf); + pm := pos('m', sdf); + py := pos('y', sdf); + if ACode = 'dm' then begin + Result := DupeString(MonthChar, 3); + Result := IfThen(pd < py, 'd/'+Result, Result+'/d'); // d/mmm + end else + if ACode = 'my' then begin + Result := DupeString(MonthChar, 3); + Result := IfThen(pm < py, Result+'/yy', 'yy/'+Result); // mmm/yy + end else + if ACode = 'ms' then begin + Result := DupeString(MinuteChar, 2) + ':ss'; // mm:ss + end + else if ACode = 'msz' then + Result := DupeString(MinuteChar, 2) + ':ss.' + MillisecChar // mm:ss.z + else + Result := ACode; +end; + +{@@ ---------------------------------------------------------------------------- + Removes an AM/PM formatting code from a given time formatting string. Variants + of "AM/PM" are considered as well. The string is left unchanged if it does not + contain AM/PM codes. + + @param ATimeFormatString String of time formatting codes (such as 'hh:nn AM/PM') + @return Formatting string with AM/PM being removed (--> 'hh:nn') +-------------------------------------------------------------------------------} +function StripAMPM(const ATimeFormatString: String): String; +var + i: Integer; +begin + Result := ''; + i := 1; + while i <= Length(ATimeFormatString) do begin + if ATimeFormatString[i] in ['a', 'A'] then begin + inc(i); + while (i <= Length(ATimeFormatString)) and (ATimeFormatString[i] in ['p', 'P', 'm', 'M', '/']) do + inc(i); + end else + Result := Result + ATimeFormatString[i]; + inc(i); + end; +end; + + +{==============================================================================} +{ TsNumFormatParams } +{==============================================================================} + +procedure TsNumFormatParams.DeleteElement(ASectionIndex, AElementIndex: Integer); +var + i, n: Integer; +begin + with Sections[ASectionIndex] do + begin + n := Length(Elements); + for i:=AElementIndex+1 to n-1 do + Elements[i-1] := Elements[i]; + SetLength(Elements, n-1); + end; +end; + + +function TsNumFormatParams.GetNumFormat: TsNumberFormat; +begin + Result := nfCustom; + case Length(Sections) of + 0: Result := nfGeneral; + 1: Result := Sections[0].NumFormat; + 2: if (Sections[0].NumFormat = Sections[1].NumFormat) and + (Sections[0].NumFormat in [nfCurrency, nfCurrencyRed]) + then + Result := Sections[0].NumFormat; + 3: if (Sections[0].NumFormat = Sections[1].NumFormat) and + (Sections[1].NumFormat = Sections[2].NumFormat) and + (Sections[0].NumFormat in [nfCurrency, nfCurrencyRed]) + then + Result := Sections[0].NumFormat; + end; +end; + +function TsNumFormatParams.GetNumFormatStr: String; +var + i: Integer; +begin + if Length(Sections) > 0 then begin + Result := BuildFormatStringFromSection(Sections[0]); + for i := 1 to High(Sections) do + Result := Result + ';' + BuildFormatStringFromSection(Sections[i]); + end else + Result := ''; +end; + +procedure TsNumFormatParams.InsertElement(ASectionIndex, AElementIndex: Integer; + AToken: TsNumFormatToken); +var + i, n: Integer; +begin + with Sections[ASectionIndex] do + begin + n := Length(Elements); + SetLength(Elements, n+1); + for i:=n-1 downto AElementIndex do + Elements[i+1] := Elements[i]; + Elements[AElementIndex].Token := AToken; + end; +end; + +function TsNumFormatParams.SectionsEqualTo(ASections: TsNumFormatSections): Boolean; +var + i, j: Integer; +begin + Result := false; + if Length(ASections) <> Length(Sections) then + exit; + for i := 0 to High(Sections) do begin + if Length(Sections[i].Elements) <> Length(ASections[i].Elements) then + exit; + + for j:=0 to High(Sections[i].Elements) do + begin + if Sections[i].Elements[j].Token <> ASections[i].Elements[j].Token then + exit; + + if Sections[i].NumFormat <> ASections[i].NumFormat then + exit; + if Sections[i].Decimals <> ASections[i].Decimals then + exit; + { + if Sections[i].Factor <> ASections[i].Factor then + exit; + } + if Sections[i].FracInt <> ASections[i].FracInt then + exit; + if Sections[i].FracNumerator <> ASections[i].FracNumerator then + exit; + if Sections[i].FracDenominator <> ASections[i].FracDenominator then + exit; + if Sections[i].CurrencySymbol <> ASections[i].CurrencySymbol then + exit; + if Sections[i].Color <> ASections[i].Color then + exit; + + case Sections[i].Elements[j].Token of + nftText, nftThSep, nftDecSep, nftDateTimeSep, + nftAMPM, nftSign, nftSignBracket, + nftExpChar, nftExpSign, nftPercent, nftFracSymbol, nftCurrSymbol, + nftCountry, nftSpace, nftEscaped, nftRepeat, nftEmptyCharWidth, + nftTextFormat: + if Sections[i].Elements[j].TextValue <> ASections[i].Elements[j].TextValue + then exit; + + nftYear, nftMonth, nftDay, + nftHour, nftMinute, nftSecond, nftMilliseconds, + nftMonthMinute, + nftIntOptDigit, nftIntZeroDigit, nftIntSpaceDigit, nftIntTh, + nftZeroDecs, nftOptDecs, nftSpaceDecs, nftExpDigits, nftFactor, + nftFracNumOptDigit, nftFracNumSpaceDigit, nftFracNumZeroDigit, + nftFracDenomOptDigit, nftFracDenomSpaceDigit, nftFracDenomZeroDigit, + nftColor: + if Sections[i].Elements[j].IntValue <> ASections[i].Elements[j].IntValue + then exit; + + nftCompareOp, nftCompareValue: + if Sections[i].Elements[j].FloatValue <> ASections[i].Elements[j].FloatValue + then exit; + end; + end; + end; + Result := true; +end; + +procedure TsNumFormatParams.SetCurrSymbol(AValue: String); +var + section: TsNumFormatSection; + s, el: Integer; +begin + for s:=0 to High(Sections) do + begin + section := Sections[s]; + if (nfkCurrency in section.Kind) then + begin + section.CurrencySymbol := AValue; + for el := 0 to High(section.Elements) do + if section.Elements[el].Token = nftCurrSymbol then + section.Elements[el].Textvalue := AValue; + end; + end; +end; + +procedure TsNumFormatParams.SetDecimals(AValue: byte); +var + section: TsNumFormatSection; + s, el: Integer; +begin + for s := 0 to High(Sections) do + begin + section := Sections[s]; + if section.Kind * [nfkFraction, nfkDate, nfkTime] <> [] then + Continue; + section.Decimals := AValue; + for el := High(section.Elements) downto 0 do + case section.Elements[el].Token of + nftZeroDecs: + section.Elements[el].Intvalue := AValue; + nftOptDecs, nftSpaceDecs: + DeleteElement(s, el); + end; + end; +end; + +procedure TsNumFormatParams.SetNegativeRed(AEnable: Boolean); +var + el: Integer; +begin + // Enable negative-value color + if AEnable then + begin + if Length(Sections) = 1 then begin + SetLength(Sections, 2); + Sections[1] := Sections[0]; + InsertElement(1, 0, nftColor); + Sections[1].Elements[0].Intvalue := scRed; + InsertElement(1, 1, nftSign); + Sections[1].Elements[1].TextValue := '-'; + end else + begin + if not (nfkHasColor in Sections[1].Kind) then + InsertElement(1, 0, nftColor); + for el := 0 to High(Sections[1].Elements) do + if Sections[1].Elements[el].Token = nftColor then + Sections[1].Elements[el].IntValue := scRed; + end; + Sections[1].Kind := Sections[1].Kind + [nfkHasColor]; + Sections[1].Color := scRed; + end else + // Disable negative-value color + if Length(Sections) >= 2 then + begin + Sections[1].Kind := Sections[1].Kind - [nfkHasColor]; + Sections[1].Color := scBlack; + for el := High(Sections[1].Elements) downto 0 do + if Sections[1].Elements[el].Token = nftColor then + DeleteElement(1, el); + end; +end; + +procedure TsNumFormatParams.SetThousandSep(AEnable: Boolean); +var + section: TsNumFormatSection; + s, el: Integer; + replaced: Boolean; +begin + for s := 0 to High(Sections) do + begin + section := Sections[s]; + replaced := false; + for el := High(section.Elements) downto 0 do + begin + if AEnable then + begin + if section.Elements[el].Token in [nftIntOptDigit, nftIntSpaceDigit, nftIntZeroDigit] then + begin + if replaced then + DeleteElement(s, el) + else begin + section.Elements[el].Token := nftIntTh; + Include(section.Kind, nfkHasThSep); + replaced := true; + end; + end; + end else + begin + if section.Elements[el].Token = nftIntTh then begin + section.Elements[el].Token := nftIntZeroDigit; + Exclude(section.Kind, nfkHasThSep); + break; + end; + end; + end; + end; +end; + + +{==============================================================================} { TsNumFormatList } -{ -----------------------------------------------------------------------------} +{==============================================================================} +{@@ ---------------------------------------------------------------------------- + Constructor of the number format list class. + + @param AFormatSettings Format settings needed internally by the number + format parser (currency symbol, etc.) + @param AOwnsData If true then the list is responsible to destroy + the list items +-------------------------------------------------------------------------------} constructor TsNumFormatList.Create(AFormatSettings: TFormatSettings; AOwnsData: Boolean); begin @@ -229,12 +1916,25 @@ begin FOwnsData := AOwnsData; end; +{@@ ---------------------------------------------------------------------------- + Destructor of the number format list class. + + Clears the list items if the list "owns" the data. +-------------------------------------------------------------------------------} destructor TsNumFormatList.Destroy; begin Clear; inherited; end; +{@@ ---------------------------------------------------------------------------- + Adds the specified sections of a parsed number format to the list. + Duplicates are not checked before adding the format item. + + @param ASections Array of number format sections as obtained by the + number format parser for a given format string + @return Index of the format item in the list. +-------------------------------------------------------------------------------} function TsNumFormatList.AddFormat(ASections: TsNumFormatSections): Integer; var nfp: TsNumFormatParams; @@ -247,6 +1947,16 @@ begin end; end; +{@@ ---------------------------------------------------------------------------- + Adds a number format as specified by a format string to the list + Uses the number format parser to convert the format string to format sections + and elements. + + Duplicates are not checked before adding the format item. + + @param AFormatStr Excel-like format string describing the format to be added + @return Index of the format item in the list +-------------------------------------------------------------------------------} function TsNumFormatList.AddFormat(AFormatStr: String): Integer; var parser: TsNumFormatParser; @@ -264,10 +1974,21 @@ begin end; end; +{@@ ---------------------------------------------------------------------------- + Adds the number formats to the list which are built into the file format. + + Does nothing here. Must be overridden by derived classes for each file format. +-------------------------------------------------------------------------------} procedure TsNumFormatList.AddBuiltinFormats; begin end; +{@@ ---------------------------------------------------------------------------- + Clears the list. + If the list "owns" the format items they are destroyed. + + @see TsNumFormatList.Create +-------------------------------------------------------------------------------} procedure TsNumFormatList.Clear; var i: Integer; @@ -276,6 +1997,13 @@ begin inherited; end; +{@@ ---------------------------------------------------------------------------- + Deletes the number format item having in the list the specified index + If the list "owns" the format items, the item is destroyed. + + @param AIndex Index of the format item to be deleted + @see TsNumformatList.Create +-------------------------------------------------------------------------------} procedure TsNumFormatList.Delete(AIndex: Integer); var p: TsNumFormatParams; @@ -288,6 +2016,14 @@ begin inherited Delete(AIndex); end; +{@@ ---------------------------------------------------------------------------- + Checks whether a parsed format item having the specified format sections is + contained in the list and returns its index if found, or -1 if not found. + + @param ASections Array of number format sections as obtained by the + number format parser for a given format string + @return Index of the found format item, or -1 if not found +-------------------------------------------------------------------------------} function TsNumFormatList.Find(ASections: TsNumFormatSections): Integer; var nfp: TsNumFormatParams; @@ -300,6 +2036,16 @@ begin Result := -1; end; +{@@ ---------------------------------------------------------------------------- + Checks whether a format item corresponding to the specified format string is + contained in the list and returns its index if found, or -1 if not. + + Should be called before adding a format to the list to avoid duplicates. + + @param AFormatStr Number format string of the format item which is seeked + @return Index of the found format item, or -1 if not found + @see TsNumFormatList.Add +-------------------------------------------------------------------------------} function TsNumFormatList.Find(AFormatStr: String): Integer; var nfp: TsNumFormatParams; @@ -311,11 +2057,26 @@ begin Result := Find(nfp.Sections); end; +{@@ ---------------------------------------------------------------------------- + Getter function returning the correct type of the list items: TsNumFormatParams + which are parsed format descriptions + + @param AIndex Index of the format item + @return Pointer to the list item at the specified index, cast to the type + TsNumFormatParams +-------------------------------------------------------------------------------} function TsNumFormatList.GetItem(AIndex: Integer): TsNumFormatParams; begin Result := TsNumFormatParams(inherited Items[AIndex]); end; +{@@ ---------------------------------------------------------------------------- + Setter function for the list items + + @param AIndex Index of the format item + @param AValue Pointer to the parsed format description to be stored in the + list at the specified index. +-------------------------------------------------------------------------------} procedure TsNumFormatList.SetItem(AIndex: Integer; const AValue: TsNumFormatParams); begin diff --git a/components/fpspreadsheet/fpsnumformatparser.pas b/components/fpspreadsheet/fpsnumformatparser.pas index ff3bcb9d7..ac664c7b1 100644 --- a/components/fpspreadsheet/fpsnumformatparser.pas +++ b/components/fpspreadsheet/fpsnumformatparser.pas @@ -7,7 +7,7 @@ unit fpsNumFormatParser; interface uses - Classes, SysUtils, fpstypes; + Classes, SysUtils, fpstypes, fpsNumFormat; const diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 266949c3e..0354d19d4 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -23,7 +23,7 @@ uses clocale, {$endif}{$endif}{$endif} Classes, SysUtils, fpimage, AVL_Tree, avglvltree, lconvencoding, - fpsTypes, fpsClasses; + fpsTypes, fpsClasses, fpsNumFormat; type { Forward declarations } @@ -781,7 +781,7 @@ uses Math, StrUtils, DateUtils, TypInfo, lazutf8, lazFileUtils, URIParser, fpsStrings, uvirtuallayer_ole, fpsUtils, fpsreaderwriter, fpsCurrency, fpsExprParser, - fpsNumFormat, fpsNumFormatParser; + fpsNumFormatParser; (* const diff --git a/components/fpspreadsheet/fpspreadsheetctrls.pas b/components/fpspreadsheet/fpspreadsheetctrls.pas index 14b6942a1..89c51a954 100644 --- a/components/fpspreadsheet/fpspreadsheetctrls.pas +++ b/components/fpspreadsheet/fpspreadsheetctrls.pas @@ -458,7 +458,7 @@ implementation uses Types, Math, TypInfo, LCLType, LCLProc, Dialogs, Forms, - fpsStrings, fpsUtils; + fpsStrings, fpsUtils, fpsNumFormat; {@@ ---------------------------------------------------------------------------- Registers the spreadsheet components in the Lazarus component palette, diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index c55ba56be..b54bd72ec 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -589,7 +589,7 @@ implementation uses Types, LCLType, LCLIntf, LCLProc, Math, StrUtils, - fpCanvas, fpsStrings, fpsUtils, fpsVisualUtils; + fpCanvas, fpsStrings, fpsUtils, fpsVisualUtils, fpsNumFormat; const {@@ Translation of the fpspreadsheet type of horizontal text alignment to that diff --git a/components/fpspreadsheet/fpsreaderwriter.pas b/components/fpspreadsheet/fpsreaderwriter.pas index 35dd59999..94d1e8891 100644 --- a/components/fpspreadsheet/fpsreaderwriter.pas +++ b/components/fpspreadsheet/fpsreaderwriter.pas @@ -154,7 +154,7 @@ implementation uses Math, - fpsStrings, fpsUtils, fpsStreams; + fpsStrings, fpsUtils, fpsNumFormat, fpsStreams; {@@ ---------------------------------------------------------------------------- Registers a new reader/writer pair for a given spreadsheet file format diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas index 897fa8f00..6d02fa931 100644 --- a/components/fpspreadsheet/fpstypes.pas +++ b/components/fpspreadsheet/fpstypes.pas @@ -483,107 +483,6 @@ type // other (format string goes directly into the file) nfCustom); - {@@ Tokens used by the elements of the number format parser } - TsNumFormatToken = ( - nftGeneral, // token for "general" number format - nftText, // must be quoted, stored in TextValue - nftThSep, // ',', replaced by FormatSettings.ThousandSeparator - nftDecSep, // '.', replaced by FormatSettings.DecimalSeparator - nftYear, // 'y' or 'Y', count stored in IntValue - nftMonth, // 'm' or 'M', count stored in IntValue - nftDay, // 'd' or 'D', count stored in IntValue - nftHour, // 'h' or 'H', count stored in IntValue - nftMinute, // 'n' or 'N' (or 'm'/'M'), count stored in IntValue - nftSecond, // 's' or 'S', count stored in IntValue - nftMilliseconds, // 'z', 'Z', '0', count stored in IntValue - nftAMPM, // - nftMonthMinute, // 'm'/'M' or 'n'/'N', meaning depending on context - nftDateTimeSep, // '/' or ':', replaced by value from FormatSettings, stored in TextValue - nftSign, // '+' or '-', stored in TextValue - nftSignBracket, // '(' or ')' for negative values, stored in TextValue - nftIntOptDigit, // '#', count stored in IntValue - nftIntZeroDigit, // '0', count stored in IntValue - nftIntSpaceDigit, // '?', count stored in IntValue - nftIntTh, // '#,##0' sequence for nfFixed, count of 0 stored in IntValue - nftZeroDecs, // '0' after dec sep, count stored in IntValue - nftOptDecs, // '#' after dec sep, count stored in IntValue - nftSpaceDecs, // '?' after dec sep, count stored in IntValue - nftExpChar, // 'e' or 'E', stored in TextValue - nftExpSign, // '+' or '-' in exponent - nftExpDigits, // '0' digits in exponent, count stored in IntValue - nftPercent, // '%' percent symbol - nftFactor, // thousand separators at end of format string, each one divides value by 1000 - nftFracSymbol, // '/' fraction symbol - nftFracNumOptDigit, // '#' in numerator, count stored in IntValue - nftFracNumSpaceDigit, // '?' in numerator, count stored in IntValue - nftFracNumZeroDigit, // '0' in numerator, count stored in IntValue - nftFracDenomOptDigit, // '#' in denominator, count stored in IntValue - nftFracDenomSpaceDigit,// '?' in denominator, count stored in IntValue - nftFracDenomZeroDigit, // '0' in denominator, count stored in IntValue - nftFracDenom, // specified denominator, value stored in IntValue - nftCurrSymbol, // e.g., '"$"', stored in TextValue - nftCountry, - nftColor, // e.g., '[red]', Color in IntValue - nftCompareOp, - nftCompareValue, - nftSpace, - nftEscaped, // '\' - nftRepeat, - nftEmptyCharWidth, - nftTextFormat); - - TsNumFormatElement = record - Token: TsNumFormatToken; - IntValue: Integer; - FloatValue: Double; - TextValue: String; - end; - - TsNumFormatElements = array of TsNumFormatElement; - - TsNumFormatKind = (nfkPercent, nfkExp, nfkCurrency, nfkFraction, - nfkDate, nfkTime, nfkTimeInterval, nfkHasColor, nfkHasThSep, nfkHasFactor); - TsNumFormatKinds = set of TsNumFormatKind; - - TsNumFormatSection = record - Elements: TsNumFormatElements; - Kind: TsNumFormatKinds; - NumFormat: TsNumberFormat; - Decimals: Byte; - Factor: Double; - FracInt: Integer; - FracNumerator: Integer; - FracDenominator: Integer; - CurrencySymbol: String; - Color: TsColor; - end; - PsNumFormatSection = ^TsNumFormatSection; - - TsNumFormatSections = array of TsNumFormatSection; - - { TsNumFormatParams } - - TsNumFormatParams = class(TObject) - private - protected - function GetNumFormat: TsNumberFormat; virtual; - function GetNumFormatStr: String; virtual; - public - Sections: TsNumFormatSections; - procedure DeleteElement(ASectionIndex, AElementIndex: Integer); - procedure InsertElement(ASectionIndex, AElementIndex: Integer; - AToken: TsNumFormatToken); - function SectionsEqualTo(ASections: TsNumFormatSections): Boolean; - procedure SetCurrSymbol(AValue: String); - procedure SetDecimals(AValue: Byte); - procedure SetNegativeRed(AEnable: Boolean); - procedure SetThousandSep(AEnable: Boolean); - property NumFormat: TsNumberFormat read GetNumFormat; - property NumFormatStr: String read GetNumFormatStr; - end; - - TsNumFormatParamsClass = class of TsNumFormatParams; - {@@ Cell calculation state } TsCalcState = (csNotCalculated, csCalculating, csCalculated); @@ -764,14 +663,9 @@ const HEADER_FOOTER_INDEX_EVEN = 2; HEADER_FOOTER_INDEX_ALL = 1; -function BuildFormatStringFromSection(const ASection: TsNumFormatSection): String; - implementation -uses - StrUtils; - { TsCellFormatList } constructor TsCellFormatList.Create(AAllowDuplicates: Boolean); @@ -941,344 +835,5 @@ begin end; -{ Creates a format string for the given number format section section. - The format string is created according to Excel convention (which is used by - ODS as well } -function BuildFormatStringFromSection(const ASection: TsNumFormatSection): String; -var - element: TsNumFormatElement; - i, n: Integer; -begin - Result := ''; - - for i := 0 to High(ASection.Elements) do begin - element := ASection.Elements[i]; - case element.Token of - nftGeneral: - Result := Result + 'General'; - nftIntOptDigit, nftOptDecs, nftFracNumOptDigit, nftFracDenomOptDigit: - if element.IntValue > 0 then - Result := Result + DupeString('#', element.IntValue); - nftIntZeroDigit, nftZeroDecs, nftFracNumZeroDigit, nftFracDenomZeroDigit, nftExpDigits: - if element.IntValue > 0 then - Result := result + DupeString('0', element.IntValue); - nftIntSpaceDigit, nftSpaceDecs, nftFracNumSpaceDigit, nftFracDenomSpaceDigit: - if element.Intvalue > 0 then - Result := result + DupeString('?', element.IntValue); - nftFracDenom: - Result := Result + IntToStr(element.IntValue); - nftIntTh: - case element.Intvalue of - 0: Result := Result + '#,###'; - 1: Result := Result + '#,##0'; - 2: Result := Result + '#,#00'; - 3: Result := Result + '#,000'; - end; - nftDecSep, nftThSep: - Result := Result + element.TextValue; - nftFracSymbol: - Result := Result + '/'; - nftPercent: - Result := Result + '%'; - nftFactor: - if element.IntValue <> 0 then - begin - n := element.IntValue; - while (n > 0) do - begin - Result := Result + element.TextValue; - dec(n); - end; - end; - nftSpace: - Result := Result + ' '; - nftText: - if element.TextValue <> '' then result := Result + '"' + element.TextValue + '"'; - nftYear: - Result := Result + DupeString('Y', element.IntValue); - nftMonth: - Result := Result + DupeString('M', element.IntValue); - nftDay: - Result := Result + DupeString('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('m', -element.IntValue) + ']' - else Result := Result + DupeString('m', element.IntValue); - nftSecond: - if element.IntValue < 0 - then Result := Result + '[' + DupeString('s', -element.IntValue) + ']' - else Result := Result + DupeString('s', element.IntValue); - nftMilliseconds: - Result := Result + DupeString('0', element.IntValue); - nftSign, nftSignBracket, nftExpChar, nftExpSign, nftAMPM, nftDateTimeSep: - if element.TextValue <> '' then Result := Result + element.TextValue; - nftCurrSymbol: - if element.TextValue <> '' then - Result := Result + '[$' + element.TextValue + ']'; - nftEscaped: - if element.TextValue <> '' then - Result := Result + '\' + element.TextValue; - nftTextFormat: - if element.TextValue <> '' then - Result := Result + element.TextValue; - nftRepeat: - if element.TextValue <> '' then Result := Result + '*' + element.TextValue; - nftColor: - 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; - - -{ TsNumFormatParams } - -procedure TsNumFormatParams.DeleteElement(ASectionIndex, AElementIndex: Integer); -var - i, n: Integer; -begin - with Sections[ASectionIndex] do - begin - n := Length(Elements); - for i:=AElementIndex+1 to n-1 do - Elements[i-1] := Elements[i]; - SetLength(Elements, n-1); - end; -end; - - -function TsNumFormatParams.GetNumFormat: TsNumberFormat; -begin - Result := nfCustom; - case Length(Sections) of - 0: Result := nfGeneral; - 1: Result := Sections[0].NumFormat; - 2: if (Sections[0].NumFormat = Sections[1].NumFormat) and - (Sections[0].NumFormat in [nfCurrency, nfCurrencyRed]) - then - Result := Sections[0].NumFormat; - 3: if (Sections[0].NumFormat = Sections[1].NumFormat) and - (Sections[1].NumFormat = Sections[2].NumFormat) and - (Sections[0].NumFormat in [nfCurrency, nfCurrencyRed]) - then - Result := Sections[0].NumFormat; - end; -end; - -function TsNumFormatParams.GetNumFormatStr: String; -var - i: Integer; -begin - if Length(Sections) > 0 then begin - Result := BuildFormatStringFromSection(Sections[0]); - for i := 1 to High(Sections) do - Result := Result + ';' + BuildFormatStringFromSection(Sections[i]); - end else - Result := ''; -end; - -procedure TsNumFormatParams.InsertElement(ASectionIndex, AElementIndex: Integer; - AToken: TsNumFormatToken); -var - i, n: Integer; -begin - with Sections[ASectionIndex] do - begin - n := Length(Elements); - SetLength(Elements, n+1); - for i:=n-1 downto AElementIndex do - Elements[i+1] := Elements[i]; - Elements[AElementIndex].Token := AToken; - end; -end; - -function TsNumFormatParams.SectionsEqualTo(ASections: TsNumFormatSections): Boolean; -var - i, j: Integer; -begin - Result := false; - if Length(ASections) <> Length(Sections) then - exit; - for i := 0 to High(Sections) do begin - if Length(Sections[i].Elements) <> Length(ASections[i].Elements) then - exit; - - for j:=0 to High(Sections[i].Elements) do - begin - if Sections[i].Elements[j].Token <> ASections[i].Elements[j].Token then - exit; - - if Sections[i].NumFormat <> ASections[i].NumFormat then - exit; - if Sections[i].Decimals <> ASections[i].Decimals then - exit; - { - if Sections[i].Factor <> ASections[i].Factor then - exit; - } - if Sections[i].FracInt <> ASections[i].FracInt then - exit; - if Sections[i].FracNumerator <> ASections[i].FracNumerator then - exit; - if Sections[i].FracDenominator <> ASections[i].FracDenominator then - exit; - if Sections[i].CurrencySymbol <> ASections[i].CurrencySymbol then - exit; - if Sections[i].Color <> ASections[i].Color then - exit; - - case Sections[i].Elements[j].Token of - nftText, nftThSep, nftDecSep, nftDateTimeSep, - nftAMPM, nftSign, nftSignBracket, - nftExpChar, nftExpSign, nftPercent, nftFracSymbol, nftCurrSymbol, - nftCountry, nftSpace, nftEscaped, nftRepeat, nftEmptyCharWidth, - nftTextFormat: - if Sections[i].Elements[j].TextValue <> ASections[i].Elements[j].TextValue - then exit; - - nftYear, nftMonth, nftDay, - nftHour, nftMinute, nftSecond, nftMilliseconds, - nftMonthMinute, - nftIntOptDigit, nftIntZeroDigit, nftIntSpaceDigit, nftIntTh, - nftZeroDecs, nftOptDecs, nftSpaceDecs, nftExpDigits, nftFactor, - nftFracNumOptDigit, nftFracNumSpaceDigit, nftFracNumZeroDigit, - nftFracDenomOptDigit, nftFracDenomSpaceDigit, nftFracDenomZeroDigit, - nftColor: - if Sections[i].Elements[j].IntValue <> ASections[i].Elements[j].IntValue - then exit; - - nftCompareOp, nftCompareValue: - if Sections[i].Elements[j].FloatValue <> ASections[i].Elements[j].FloatValue - then exit; - end; - end; - end; - Result := true; -end; - -procedure TsNumFormatParams.SetCurrSymbol(AValue: String); -var - section: TsNumFormatSection; - s, el: Integer; -begin - for s:=0 to High(Sections) do - begin - section := Sections[s]; - if (nfkCurrency in section.Kind) then - begin - section.CurrencySymbol := AValue; - for el := 0 to High(section.Elements) do - if section.Elements[el].Token = nftCurrSymbol then - section.Elements[el].Textvalue := AValue; - end; - end; -end; - -procedure TsNumFormatParams.SetDecimals(AValue: byte); -var - section: TsNumFormatSection; - s, el: Integer; -begin - for s := 0 to High(Sections) do - begin - section := Sections[s]; - if section.Kind * [nfkFraction, nfkDate, nfkTime] <> [] then - Continue; - section.Decimals := AValue; - for el := High(section.Elements) downto 0 do - case section.Elements[el].Token of - nftZeroDecs: - section.Elements[el].Intvalue := AValue; - nftOptDecs, nftSpaceDecs: - DeleteElement(s, el); - end; - end; -end; - -procedure TsNumFormatParams.SetNegativeRed(AEnable: Boolean); -var - el: Integer; -begin - // Enable negative-value color - if AEnable then - begin - if Length(Sections) = 1 then begin - SetLength(Sections, 2); - Sections[1] := Sections[0]; - InsertElement(1, 0, nftColor); - Sections[1].Elements[0].Intvalue := scRed; - InsertElement(1, 1, nftSign); - Sections[1].Elements[1].TextValue := '-'; - end else - begin - if not (nfkHasColor in Sections[1].Kind) then - InsertElement(1, 0, nftColor); - for el := 0 to High(Sections[1].Elements) do - if Sections[1].Elements[el].Token = nftColor then - Sections[1].Elements[el].IntValue := scRed; - end; - Sections[1].Kind := Sections[1].Kind + [nfkHasColor]; - Sections[1].Color := scRed; - end else - // Disable negative-value color - if Length(Sections) >= 2 then - begin - Sections[1].Kind := Sections[1].Kind - [nfkHasColor]; - Sections[1].Color := scBlack; - for el := High(Sections[1].Elements) downto 0 do - if Sections[1].Elements[el].Token = nftColor then - DeleteElement(1, el); - end; -end; - -procedure TsNumFormatParams.SetThousandSep(AEnable: Boolean); -var - section: TsNumFormatSection; - s, el: Integer; - replaced: Boolean; -begin - for s := 0 to High(Sections) do - begin - section := Sections[s]; - replaced := false; - for el := High(section.Elements) downto 0 do - begin - if AEnable then - begin - if section.Elements[el].Token in [nftIntOptDigit, nftIntSpaceDigit, nftIntZeroDigit] then - begin - if replaced then - DeleteElement(s, el) - else begin - section.Elements[el].Token := nftIntTh; - Include(section.Kind, nfkHasThSep); - replaced := true; - end; - end; - end else - begin - if section.Elements[el].Token = nftIntTh then begin - section.Elements[el].Token := nftIntZeroDigit; - Exclude(section.Kind, nfkHasThSep); - break; - end; - end; - end; - end; -end; - end. diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 8028bb2a8..c966a3798 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -25,9 +25,6 @@ type {@@ Selection direction along column or along row } TsSelectionDirection = (fpsVerticalSelection, fpsHorizontalSelection); - {@@ Set of characters } - TsDecsChars = set of char; - {@@ Color value, composed of r(ed), g(reen) and b(lue) components } TRGBA = record r, g, b, a: byte end; @@ -95,31 +92,6 @@ function GetFormatFromFileName(const AFileName: TFileName; function IfThen(ACondition: Boolean; AValue1,AValue2: TsNumberFormat): TsNumberFormat; overload; -procedure BuildCurrencyFormatList(AList: TStrings; - APositive: Boolean; AValue: Double; const ACurrencySymbol: String); -function BuildCurrencyFormatString(ANumberFormat: TsNumberFormat; - const AFormatSettings: TFormatSettings; ADecimals, APosCurrFmt, ANegCurrFmt: Integer; - ACurrencySymbol: String; Accounting: Boolean = false): 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; - -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(ADateFormat: String): String; -function MakeShortDateFormat(ADateFormat: String): String; -function SpecialDateTimeFormat(ACode: String; - const AFormatSettings: TFormatSettings; ForWriting: Boolean): String; -procedure MakeTimeIntervalMask(Src: String; var Dest: String); - -function ConvertFloatToStr(AValue: Double; AParams: TsNumFormatParams; - AFormatSettings: TFormatSettings): String; procedure FloatToFraction(AValue: Double; AMaxDenominator: Int64; out ANumerator, ADenominator: Int64); function TryStrToFloatAuto(AText: String; out ANumber: Double; @@ -193,33 +165,6 @@ implementation uses Math, lazutf8, fpsStrings; -const - POS_CURR_FMT: array[0..3] of string = ( - // Format parameter 0 is "value", parameter 1 is "currency symbol" - ('%1:s%0:s'), // 0: $1 - ('%0:s%1:s'), // 1: 1$ - ('%1:s %0:s'), // 2: $ 1 - ('%0:s %1:s') // 3: 1 $ - ); - NEG_CURR_FMT: array[0..15] of string = ( - ('(%1:s%0:s)'), // 0: ($1) - ('-%1:s%0:s'), // 1: -$1 - ('%1:s-%0:s'), // 2: $-1 - ('%1:s%0:s-'), // 3: $1- - ('(%0:s%1:s)'), // 4: (1$) - ('-%0:s%1:s'), // 5: -1$ - ('%0:s-%1:s'), // 6: 1-$ - ('%0:s%1:s-'), // 7: 1$- - ('-%0:s %1:s'), // 8: -1 $ - ('-%1:s %0:s'), // 9: -$ 1 - ('%0:s %1:s-'), // 10: 1 $- - ('%1:s %0:s-'), // 11: $ 1- - ('%1:s -%0:s'), // 12: $ -1 - ('%0:s- %1:s'), // 13: 1- $ - ('(%1:s %0:s)'), // 14: ($ 1) - ('(%0:s %1:s)') // 15: (1 $) - ); - {******************************************************************************} { Endianess helper functions } {******************************************************************************} @@ -921,408 +866,6 @@ begin if ACondition then Result := AValue1 else Result := AValue2; end; -{@@ ---------------------------------------------------------------------------- - Builds a date/time format string from the number format code. - - @param ANumberFormat built-in number format identifier - @param AFormatSettings Format settings from which locale-dependent - information like day-month-year order is taken. - @param AFormatString Optional pre-built formatting string. It is used - only for the format nfInterval where square brackets - are added to the first time code field. - @return String of date/time formatting code constructed from the built-in - format information. --------------------------------------------------------------------------------} -function BuildDateTimeFormatString(ANumberFormat: TsNumberFormat; - const AFormatSettings: TFormatSettings; AFormatString: String = '') : string; -var - i, j: Integer; - Unwanted: set of ansichar; -begin - case ANumberFormat of - nfShortDateTime: - Result := AFormatSettings.ShortDateFormat + ' ' + AFormatSettings.ShortTimeFormat; - // In the DefaultFormatSettings this is: d/m/y hh:nn - nfShortDate: - Result := AFormatSettings.ShortDateFormat; // --> d/m/y - nfLongDate: - Result := AFormatSettings.LongDateFormat; // --> dd mm yyyy - nfShortTime: - Result := StripAMPM(AFormatSettings.ShortTimeFormat); // --> hh:nn - nfLongTime: - Result := StripAMPM(AFormatSettings.LongTimeFormat); // --> hh:nn:ss - nfShortTimeAM: - begin // --> hh:nn AM/PM - Result := AFormatSettings.ShortTimeFormat; - if (pos('a', lowercase(AFormatSettings.ShortTimeFormat)) = 0) then - Result := AddAMPM(Result, AFormatSettings); - end; - nfLongTimeAM: // --> hh:nn:ss AM/PM - begin - Result := AFormatSettings.LongTimeFormat; - if pos('a', lowercase(AFormatSettings.LongTimeFormat)) = 0 then - Result := AddAMPM(Result, AFormatSettings); - end; - nfDayMonth, // --> dd/mmm - nfMonthYear: // --> mmm/yy - begin - Result := AFormatSettings.ShortDateFormat; - case ANumberFormat of - nfDayMonth: - unwanted := ['y', 'Y']; - nfMonthYear: - unwanted := ['d', 'D']; - end; - for i:=Length(Result) downto 1 do - if Result[i] in unwanted then Delete(Result, i, 1); - while not (Result[1] in (['m', 'M', 'd', 'D', 'y', 'Y'] - unwanted)) do - Delete(Result, 1, 1); - while not (Result[Length(Result)] in (['m', 'M', 'd', 'D', 'y', 'Y'] - unwanted)) do - Delete(Result, Length(Result), 1); - i := 1; - while not (Result[i] in ['m', 'M']) do inc(i); - j := i; - while (j <= Length(Result)) and (Result[j] in ['m', 'M']) do inc(j); - while (j - i < 3) do begin - Insert(Result[i], Result, j); - inc(j); - end; - end; - nfTimeInterval: // --> [h]:nn:ss - if AFormatString = '' then - Result := '[h]:nn:ss' - else - Result := AddIntervalBrackets(AFormatString); - end; -end; - -{@@ ---------------------------------------------------------------------------- - Builds a string list with samples of the predefined currency formats - - @param AList String list in which the format samples are stored - @param APositive If true, samples are built for positive currency - values, otherwise for negative values - @param AValue Currency value to be used when calculating the sample - strings - @param ACurrencySymbol Currency symbol string to be used in the samples --------------------------------------------------------------------------------} -procedure BuildCurrencyFormatList(AList: TStrings; - APositive: Boolean; AValue: Double; const ACurrencySymbol: String); -var - valueStr: String; - i: Integer; -begin - valueStr := Format('%.0n', [AValue]); - AList.BeginUpdate; - try - if AList.Count = 0 then - begin - if APositive then - for i:=0 to High(POS_CURR_FMT) do - AList.Add(Format(POS_CURR_FMT[i], [valueStr, ACurrencySymbol])) - else - for i:=0 to High(NEG_CURR_FMT) do - AList.Add(Format(NEG_CURR_FMT[i], [valueStr, ACurrencySymbol])); - end else - begin - if APositive then - for i:=0 to High(POS_CURR_FMT) do - AList[i] := Format(POS_CURR_FMT[i], [valueStr, ACurrencySymbol]) - else - for i:=0 to High(NEG_CURR_FMT) do - AList[i] := Format(NEG_CURR_FMT[i], [valueStr, ACurrencySymbol]); - end; - finally - AList.EndUpdate; - end; -end; - - -{@@ ---------------------------------------------------------------------------- - Builds a currency format string. The presentation of negative values (brackets, - or minus signs) is taken from the provided format settings. The format string - consists of three sections, separated by semicolons. - - @param ANumberFormat Identifier of the built-in number format for which the - format string is to be generated. - @param AFormatSettings FormatSettings to be applied (used to extract default - values for the next parameters) - @param ADecimals number of decimal places. If < 0, the CurrencyDecimals - of the FormatSettings is used. - @param APosCurrFmt Identifier for the order of currency symbol, value and - spaces of positive values - - see pcfXXXX constants in fpspreadsheet.pas. - If < 0, the CurrencyFormat of the FormatSettings is used. - @param ANegCurrFmt Identifier for the order of currency symbol, value and - spaces of negative values. Specifies also usage of (). - - see ncfXXXX constants in fpspreadsheet.pas. - If < 0, the NegCurrFormat of the FormatSettings is used. - @param ACurrencySymbol Name of the currency, like $ or USD. - If ? the CurrencyString of the FormatSettings is used. - @param Accounting If true, adds spaces for alignment of decimals - - @return String of formatting codes, such as '"$"#,##0.00;("$"#,##0.00);"$"0.00' --------------------------------------------------------------------------------} -function BuildCurrencyFormatString(ANumberFormat: TsNumberFormat; - const AFormatSettings: TFormatSettings; - ADecimals, APosCurrFmt, ANegCurrFmt: Integer; ACurrencySymbol: String; - Accounting: Boolean = false): String; -{ -const - POS_FMT: array[0..3] of string = ( - // Format parameter 0 is "value", parameter 1 is "currency symbol" - ('"%1:s"%0:s'), // 0: $1 - ('%0:s"%1:s"'), // 1: 1$ - ('"%1:s" %0:s'), // 2: $ 1 - ('%0:s "%1:s"') // 3: 1 $ - ); - NEG_FMT: array[0..15] of string = ( - ('("%1:s"%0:s)'), // 0: ($1) - ('-"%1:s"%0:s'), // 1: -$1 - ('"%1:s"-%0:s'), // 2: $-1 - ('"%1:s"%0:s-'), // 3: $1- - ('(%0:s"%1:s")'), // 4: (1$) - ('-%0:s"%1:s"'), // 5: -1$ - ('%0:s-"%1:s"'), // 6: 1-$ - ('%0:s"%1:s"-'), // 7: 1$- - ('-%0:s "%1:s"'), // 8: -1 $ - ('-"%1:s" %0:s'), // 9: -$ 1 - ('%0:s "%1:s"-'), // 10: 1 $- - ('"%1:s" %0:s-'), // 11: $ 1- - ('"%1:s" -%0:s'), // 12: $ -1 - ('%0:s- "%1:s"'), // 13: 1- $ - ('("%1:s" %0:s)'), // 14: ($ 1) - ('(%0:s "%1:s")') // 15: (1 $) - ); - } -var - decs: String; - pcf, ncf: Byte; - p, n: String; - negRed: Boolean; -begin - pcf := IfThen(APosCurrFmt < 0, AFormatSettings.CurrencyFormat, APosCurrFmt); - ncf := IfThen(ANegCurrFmt < 0, AFormatSettings.NegCurrFormat, ANegCurrFmt); - if (ADecimals < 0) then - ADecimals := AFormatSettings.CurrencyDecimals; - if ACurrencySymbol = '?' then - ACurrencySymbol := AFormatSettings.CurrencyString; - if ACurrencySymbol <> '' then - ACurrencySymbol := '"' + ACurrencySymbol + '"'; - decs := DupeString('0', ADecimals); - if ADecimals > 0 then decs := '.' + decs; - - negRed := (ANumberFormat = nfCurrencyRed); - p := POS_CURR_FMT[pcf]; // Format mask for positive values - n := NEG_CURR_FMT[ncf]; // Format mask for negative values - - // add extra space for the sign of the number for perfect alignment in Excel - if Accounting then - case ncf of - 0, 14: p := p + '_)'; - 3, 11: p := p + '_-'; - 4, 15: p := '_(' + p; - 5, 8 : p := '_-' + p; - end; - - if ACurrencySymbol <> '' then begin - Result := Format(p, ['#,##0' + decs, ACurrencySymbol]) + ';' - + IfThen(negRed, '[red]', '') - + Format(n, ['#,##0' + decs, ACurrencySymbol]) + ';' - + Format(p, ['0'+decs, ACurrencySymbol]); - end - else begin - Result := '#,##0' + decs; - if negRed then - Result := Result +';[red]' - else - Result := Result +';'; - case ncf of - 0, 14, 15 : Result := Result + '(#,##0' + decs + ')'; - 1, 2, 5, 6, 8, 9, 12: Result := Result + '-#,##0' + decs; - else Result := Result + '#,##0' + decs + '-'; - end; - Result := Result + ';0' + decs; - 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 - if ADenominatorDigits < 0 then // a negative value indicates a fixed denominator value - Result := Format('%s/%d', [ - DupeString('?', ANumeratorDigits), -ADenominatorDigits - ]) - else - 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. - - @param ANumberFormat Identifier of the built-in numberformat for which a - format string is to be generated - @param AFormatSettings FormatSettings for default parameters - @param ADecimals Number of decimal places. If < 0 the CurrencyDecimals - value of the FormatSettings is used. - - @return String of formatting codes, such as '#,##0.00' for nfFixedTh and 2 decimals --------------------------------------------------------------------------------} -function BuildNumberFormatString(ANumberFormat: TsNumberFormat; - const AFormatSettings: TFormatSettings; ADecimals: Integer = -1): String; -var - decs: String; -begin - Result := ''; - if ADecimals = -1 then - ADecimals := AFormatSettings.CurrencyDecimals; - decs := DupeString('0', ADecimals); - if ADecimals > 0 then decs := '.' + decs; - case ANumberFormat of - nfFixed: - Result := '0' + decs; - nfFixedTh: - Result := '#,##0' + decs; - nfExp: - Result := '0' + decs + 'E+00'; - nfPercentage: - Result := '0' + decs + '%'; - nfFraction: - if ADecimals = 0 then - Result := '# ??/??' - else - begin - decs := DupeString('?', ADecimals); - Result := '# ' + decs + '/' + decs; - end; - nfCurrency, nfCurrencyRed: - Result := BuildCurrencyFormatString(ANumberFormat, AFormatSettings, - ADecimals, AFormatSettings.CurrencyFormat, AFormatSettings.NegCurrFormat, - AFormatSettings.CurrencyString); - nfShortDateTime, nfShortDate, nfLongDate, nfShortTime, nfLongTime, - nfShortTimeAM, nfLongTimeAM, nfDayMonth, nfMonthYear, nfTimeInterval: - raise Exception.Create('BuildNumberFormatString: Use BuildDateTimeFormatSstring '+ - 'to create a format string for date/time values.'); - end; -end; - -{@@ ---------------------------------------------------------------------------- - Adds an AM/PM format code to a pre-built time formatting string. The strings - replacing "AM" or "PM" in the final formatted number are taken from the - TimeAMString or TimePMString of the given FormatSettings. - - @param ATimeFormatString String of time formatting codes (such as 'hh:nn') - @param AFormatSettings FormatSettings for locale-dependent information - @result Formatting string with AM/PM option activated. - - Example: ATimeFormatString = 'hh:nn' ==> 'hh:nn AM/PM' --------------------------------------------------------------------------------} -function AddAMPM(const ATimeFormatString: String; - const AFormatSettings: TFormatSettings): String; -var - am, pm: String; -begin - am := IfThen(AFormatSettings.TimeAMString <> '', AFormatSettings.TimeAMString, 'AM'); - pm := IfThen(AFormatSettings.TimePMString <> '', AFormatSettings.TimePMString, 'PM'); - Result := Format('%s %s/%s', [StripAMPM(ATimeFormatString), am, pm]); -end; - -{@@ ---------------------------------------------------------------------------- - Removes an AM/PM formatting code from a given time formatting string. Variants - of "AM/PM" are considered as well. The string is left unchanged if it does not - contain AM/PM codes. - - @param ATimeFormatString String of time formatting codes (such as 'hh:nn AM/PM') - @return Formatting string with AM/PM being removed (--> 'hh:nn') --------------------------------------------------------------------------------} -function StripAMPM(const ATimeFormatString: String): String; -var - i: Integer; -begin - Result := ''; - i := 1; - while i <= Length(ATimeFormatString) do begin - if ATimeFormatString[i] in ['a', 'A'] then begin - inc(i); - while (i <= Length(ATimeFormatString)) and (ATimeFormatString[i] in ['p', 'P', 'm', 'M', '/']) do - inc(i); - end else - Result := Result + ATimeFormatString[i]; - inc(i); - end; -end; - -{@@ ---------------------------------------------------------------------------- - Counts how many decimal places are coded into a given formatting string. - - @param AFormatString String with number format codes, such as '0.000' - @param ADecChars Characters which are considered as symbols for decimals. - For the fixed decimals, this is the '0'. Optional - decimals are encoced as '#'. - @return Count of decimal places found (3 in above example). --------------------------------------------------------------------------------} -function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte; -var - i: Integer; -begin - Result := 0; - 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; -end; - -{@@ ---------------------------------------------------------------------------- - The given format string is assumed to represent a time interval, i.e. its - first time symbol must be enclosed by square brackets. Checks if this is true, - and adds the brackes if not. - - @param AFormatString String with time formatting codes - @return Unchanged format string if its first time code is in square brackets - (as in '[h]:nn:ss'), if not, the first time code is enclosed in - square brackets. --------------------------------------------------------------------------------} -function AddIntervalBrackets(AFormatString: String): String; -var - p: Integer; - s1, s2: String; -begin - if AFormatString[1] = '[' then - Result := AFormatString - else begin - p := pos(':', AFormatString); - if p <> 0 then begin - s1 := copy(AFormatString, 1, p-1); - s2 := copy(AFormatString, p, Length(AFormatString)); - Result := Format('[%s]%s', [s1, s2]); - end else - Result := Format('[%s]', [AFormatString]); - end; -end; - {@@ ---------------------------------------------------------------------------- Approximates a floating point value as a fraction and returns the values of numerator and denominator. @@ -1403,148 +946,6 @@ begin ADenominator := K1; end; - -{@@ ---------------------------------------------------------------------------- - Creates a long date format string out of a short date format string. - Retains the order of year-month-day and the separators, but uses 4 digits - for year and 3 digits of month. - - @param ADateFormat String with date formatting code representing a - "short" date, such as 'dd/mm/yy' - @return Format string modified to represent a "long" date, such as 'dd/mmm/yyyy' --------------------------------------------------------------------------------} -function MakeLongDateFormat(ADateFormat: String): String; -var - i: Integer; -begin - Result := ''; - i := 1; - while i < Length(ADateFormat) do begin - case ADateFormat[i] of - 'y', 'Y': - begin - Result := Result + DupeString(ADateFormat[i], 4); - while (i < Length(ADateFormat)) and (ADateFormat[i] in ['y','Y']) do - inc(i); - end; - 'm', 'M': - begin - result := Result + DupeString(ADateFormat[i], 3); - while (i < Length(ADateFormat)) and (ADateFormat[i] in ['m','M']) do - inc(i); - end; - else - Result := Result + ADateFormat[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. - - @param ADateFormat String with date formatting codes representing a - "long" date, such as 'dd/mmm/yyyy' - @return Format string modified to represent a "short" date, such as 'dd/mm/yy' --------------------------------------------------------------------------------} -function MakeShortDateFormat(ADateFormat: String): String; -var - i: Integer; -begin - Result := ''; - i := 1; - while i < Length(ADateFormat) do begin - case ADateFormat[i] of - 'y', 'Y': - begin - Result := Result + DupeString(ADateFormat[i], 2); - while (i < Length(ADateFormat)) and (ADateFormat[i] in ['y','Y']) do - inc(i); - end; - 'm', 'M': - begin - result := Result + DupeString(ADateFormat[i], 2); - while (i < Length(ADateFormat)) and (ADateFormat[i] in ['m','M']) do - inc(i); - end; - else - Result := Result + ADateFormat[i]; - inc(i); - end; - end; -end; - -{@@ ---------------------------------------------------------------------------- - Creates the formatstrings for the date/time codes "dm", "my", "ms" and "msz" - out of the formatsettings. - - @param ACode Quick formatting code for parts of date/time number formats; - "dm" = day + month - "my" = month + year - "ms" = minutes + seconds - "msz" = minutes + seconds + fractions of a second - @return String of formatting codes according to the parameter ACode --------------------------------------------------------------------------------} -function SpecialDateTimeFormat(ACode: String; - const AFormatSettings: TFormatSettings; ForWriting: Boolean): String; -var - pd, pm, py: Integer; - sdf: String; - MonthChar, MinuteChar, MillisecChar: Char; -begin - if ForWriting then begin - MonthChar := 'M'; MinuteChar := 'm'; MillisecChar := '0'; - end else begin - MonthChar := 'm'; MinuteChar := 'n'; MillisecChar := 'z'; - end; - ACode := lowercase(ACode); - sdf := lowercase(AFormatSettings.ShortDateFormat); - pd := pos('d', sdf); - pm := pos('m', sdf); - py := pos('y', sdf); - if ACode = 'dm' then begin - Result := DupeString(MonthChar, 3); - Result := IfThen(pd < py, 'd/'+Result, Result+'/d'); // d/mmm - end else - if ACode = 'my' then begin - Result := DupeString(MonthChar, 3); - Result := IfThen(pm < py, Result+'/yy', 'yy/'+Result); // mmm/yy - end else - if ACode = 'ms' then begin - Result := DupeString(MinuteChar, 2) + ':ss'; // mm:ss - end - else if ACode = 'msz' then - Result := DupeString(MinuteChar, 2) + ':ss.' + MillisecChar // mm:ss.z - else - Result := ACode; -end; - -{@@ ---------------------------------------------------------------------------- - Creates a "time interval" format string having the first time code identifier - in square brackets. - - @param Src Source format string, must be a time format string, like 'hh:nn' - @param Dest Destination format string, will have the first time code element - of the src format string in square brackets, like '[hh]:nn'. --------------------------------------------------------------------------------} -procedure MakeTimeIntervalMask(Src: String; var Dest: String); -var - L: TStrings; -begin - L := TStringList.Create; - try - L.StrictDelimiter := true; - L.Delimiter := ':'; - L.DelimitedText := Src; - if L[0][1] <> '[' then L[0] := '[' + L[0]; - if L[0][Length(L[0])] <> ']' then L[0] := L[0] + ']'; - Dest := L.DelimitedText; - finally - L.Free; - end; -end; - {@@ ---------------------------------------------------------------------------- Converts a string to a floating point number. No assumption on decimal and thousand separator are made. @@ -2457,650 +1858,6 @@ begin AppendToStream(AStream, AString3); end; - -type - TsNumFormatTokenSet = set of TsNumFormatToken; - -const - TERMINATING_TOKENS: TsNumFormatTokenSet = - [nftSpace, nftText, nftEscaped, nftPercent, nftCurrSymbol, nftSign, nftSignBracket]; - INT_TOKENS: TsNumFormatTokenSet = - [nftIntOptDigit, nftIntZeroDigit, nftIntSpaceDigit]; - DECS_TOKENS: TsNumFormatTokenSet = - [nftZeroDecs, nftOptDecs, nftSpaceDecs]; - FRACNUM_TOKENS: TsNumFormatTokenSet = - [nftFracNumOptDigit, nftFracNumZeroDigit, nftFracNumSpaceDigit]; - FRACDENOM_TOKENS: TsNumFormatTokenSet = - [nftFracDenomOptDigit, nftFracDenomZeroDigit, nftFracDenomSpaceDigit, nftFracDenom]; - EXP_TOKENS: TsNumFormatTokenSet = - [nftExpDigits]; // todo: expand by optional digits (0.00E+#) - -{ Checks whether a sequence of format tokens for exponential formatting begins - at the specified index in the format elements } -function CheckExp(const AElements: TsNumFormatElements; AIndex: Integer): Boolean; -var - numEl: Integer; - i: Integer; -begin - numEl := Length(AElements); - - Result := (AIndex < numEl) and (AElements[AIndex].Token in INT_TOKENS); - if not Result then - exit; - - numEl := Length(AElements); - i := AIndex + 1; - while (i < numEl) and (AElements[i].Token in INT_TOKENS) do inc(i); - - // no decimal places - if (i+2 < numEl) and - (AElements[i].Token = nftExpChar) and - (AElements[i+1].Token = nftExpSign) and - (AElements[i+2].Token in EXP_TOKENS) - then begin - Result := true; - exit; - end; - - // with decimal places - if (i < numEl) and (AElements[i].Token = nftDecSep) //and (AElements[i+1].Token in DECS_TOKENS) - then begin - inc(i); - while (i < numEl) and (AElements[i].Token in DECS_TOKENS) do inc(i); - if (i + 2 < numEl) and - (AElements[i].Token = nftExpChar) and - (AElements[i+1].Token = nftExpSign) and - (AElements[i+2].Token in EXP_TOKENS) - then begin - Result := true; - exit; - end; - end; - - Result := false; -end; - -function CheckFraction(const AElements: TsNumFormatElements; AIndex: Integer; - out digits: Integer): Boolean; -var - numEl: Integer; - i: Integer; -begin - digits := 0; - numEl := Length(AElements); - - Result := (AIndex < numEl); - if not Result then - exit; - - i := AIndex; - // Check for mixed fraction (integer split off, sample format "# ??/??" - if (AElements[i].Token in (INT_TOKENS + [nftIntTh])) then - begin - inc(i); - while (i < numEl) and (AElements[i].Token in (INT_TOKENS + [nftIntTh])) do inc(i); - while (i < numEl) and (AElements[i].Token in TERMINATING_TOKENS) do inc(i); - end; - - if (i = numEl) or not (AElements[i].Token in FRACNUM_TOKENS) then - exit(false); - - // Here follows the ordinary fraction (no integer split off); sample format "??/??" - while (i < numEl) and (AElements[i].Token in FRACNUM_TOKENS) do inc(i); - while (i < numEl) and (AElements[i].Token in TERMINATING_TOKENS) do inc(i); - if (i = numEl) or (AElements[i].Token <> nftFracSymbol) then - exit(False); - - inc(i); - while (i < numEl) and (AElements[i].Token in TERMINATING_TOKENS) do inc(i); - if (i = numEl) or (not (AElements[i].Token in FRACDENOM_TOKENS)) then - exit(false); - - while (i < numEL) and (AElements[i].Token in FRACDENOM_TOKENS) do - begin - case AElements[i].Token of - nftFracDenomZeroDigit : inc(digits, AElements[i].IntValue); - nftFracDenomSpaceDigit: inc(digits, AElements[i].IntValue); - nftFracDenomOptDigit : inc(digits, AElements[i].IntValue); - nftFracDenom : digits := -AElements[i].IntValue; // "-" indicates a literal denominator value! - end; - inc(i); - end; - Result := true; -end; - -{ Processes a sequence of #, 0, and ? tokens. - Adds leading (GrowRight=false) or trailing (GrowRight=true) zeros and/or - spaces as specified by the format elements to the number value string. - On exit AIndex points to the first non-integer token. } -function ProcessIntegerFormat(AValue: String; AFormatSettings: TFormatSettings; - const AElements: TsNumFormatElements; var AIndex: Integer; - ATokens: TsNumFormatTokenSet; GrowRight, UseThSep: Boolean): String; -const - OptTokens = [nftIntOptDigit, nftFracNumOptDigit, nftFracDenomOptDigit, nftOptDecs]; - ZeroTokens = [nftIntZeroDigit, nftFracNumZeroDigit, nftFracDenomZeroDigit, nftZeroDecs, nftIntTh]; - SpaceTokens = [nftIntSpaceDigit, nftFracNumSpaceDigit, nftFracDenomSpaceDigit, nftSpaceDecs]; - AllOptTokens = OptTokens + SpaceTokens; -var - fs: TFormatSettings absolute AFormatSettings; - i, j, L: Integer; - numEl: Integer; -begin - Result := AValue; - numEl := Length(AElements); - if GrowRight then - begin - // This branch is intended for decimal places, i.e. there may be trailing zeros. - i := AIndex; - if (AValue = '0') and (AElements[i].Token in AllOptTokens) then - Result := ''; - // Remove trailing zeros - while (Result <> '') and (Result[Length(Result)] = '0') - do Delete(Result, Length(Result), 1); - // Add trailing zeros or spaces as required by the elements. - i := AIndex; - L := 0; - while (i < numEl) and (AElements[i].Token in ATokens) do - begin - if AElements[i].Token in ZeroTokens then - begin - inc(L, AElements[i].IntValue); - while Length(Result) < L do Result := Result + '0' - end else - if AElements[i].Token in SpaceTokens then - begin - inc(L, AElements[i].IntValue); - while Length(Result) < L do Result := Result + ' '; - end; - inc(i); - end; - if UseThSep then begin - j := 2; - while (j < Length(Result)) and (Result[j-1] <> ' ') and (Result[j] <> ' ') do - begin - Insert(fs.ThousandSeparator, Result, 1); - inc(j, 3); - end; - end; - AIndex := i; - end else - begin - // This branch is intended for digits (or integer and numerator parts of fractions) - // --> There are no leading zeros. - // Find last digit token of the sequence - i := AIndex; - while (i < numEl) and (AElements[i].Token in ATokens) do - inc(i); - j := i; - if i > 0 then dec(i); - if (AValue = '0') and (AElements[i].Token in AllOptTokens) and (i = AIndex) then - Result := ''; - // From the end of the sequence, going backward, add leading zeros or spaces - // as required by the elements of the format. - L := 0; - while (i >= AIndex) do begin - if AElements[i].Token in ZeroTokens then - begin - inc(L, AElements[i].IntValue); - while Length(Result) < L do Result := '0' + Result; - end else - if AElements[i].Token in SpaceTokens then - begin - inc(L, AElements[i].IntValue); - while Length(Result) < L do Result := ' ' + Result; - end; - dec(i); - end; - AIndex := j; - if UseThSep then - begin - // AIndex := j + 1; - j := Length(Result) - 2; - while (j > 1) and (Result[j-1] <> ' ') and (Result[j] <> ' ') do - begin - Insert(fs.ThousandSeparator, Result, j); - dec(j, 3); - end; - end; - end; -end; - -{ Converts the floating point number to an exponential number string according - to the format specification in AElements. - It must have been verified before, that the elements in fact are valid for - an exponential format. } -function ProcessExpFormat(AValue: Double; AFormatSettings: TFormatSettings; - const AElements: TsNumFormatElements; var AIndex: Integer): String; -var - fs: TFormatSettings absolute AFormatSettings; - expchar: String; - expSign: String; - se, si, sd: String; - decs, expDigits: Integer; - intZeroDigits, intOptDigits, intSpaceDigits: Integer; - numStr: String; - i, id, p: Integer; - numEl: Integer; -begin - Result := ''; - numEl := Length(AElements); - - // Determine digits of integer part of mantissa - intZeroDigits := 0; - intOptDigits := 0; - intSpaceDigits := 0; - i := AIndex; - while (AElements[i].Token in INT_TOKENS) do begin - case AElements[i].Token of - nftIntZeroDigit : inc(intZeroDigits, AElements[i].IntValue); - nftIntSpaceDigit: inc(intSpaceDigits, AElements[i].IntValue); - nftIntOptDigit : inc(intOptDigits, AElements[i].IntValue); - end; - inc(i); - end; - - // No decimal places - if (i + 2 < numEl) and (AElements[i].Token = nftExpChar) then - begin - expChar := AElements[i].TextValue; - expSign := AElements[i+1].TextValue; - expDigits := 0; - i := i+2; - while (i < numEl) and (AElements[i].Token in EXP_TOKENS) do - begin - inc(expDigits, AElements[i].IntValue); // not exactly what Excel does... Rather exotic case... - inc(i); - end; - numstr := FormatFloat('0'+expChar+expSign+DupeString('0', expDigits), AValue, fs); - p := pos('e', Lowercase(numStr)); - se := copy(numStr, p, Length(numStr)); // exp part of the number string, incl "E" - numStr := copy(numstr, 1, p-1); // mantissa of the number string - numStr := ProcessIntegerFormat(numStr, fs, AElements, AIndex, INT_TOKENS, false, false); - Result := numStr + se; - AIndex := i; - end - else - // With decimal places - if (i + 1 < numEl) and (AElements[i].Token = nftDecSep) then - begin - inc(i); - id := i; // index of decimal elements - decs := 0; - while (i < numEl) and (AElements[i].Token in DECS_TOKENS) do - begin - case AElements[i].Token of - nftZeroDecs, - nftSpaceDecs: inc(decs, AElements[i].IntValue); - end; - inc(i); - end; - expChar := AElements[i].TextValue; - expSign := AElements[i+1].TextValue; - expDigits := 0; - inc(i, 2); - while (i < numEl) and (AElements[i].Token in EXP_TOKENS) do - begin - inc(expDigits, AElements[i].IntValue); - inc(i); - end; - if decs=0 then - numstr := FormatFloat('0'+expChar+expSign+DupeString('0', expDigits), AValue, fs) - else - numStr := FloatToStrF(AValue, ffExponent, decs+1, expDigits, fs); - if (abs(AValue) >= 1.0) and (expSign = '-') then - Delete(numStr, pos('+', numStr), 1); - p := pos('e', Lowercase(numStr)); - se := copy(numStr, p, Length(numStr)); // exp part of the number string, incl "E" - numStr := copy(numStr, 1, p-1); // mantissa of the number string - p := pos(fs.DecimalSeparator, numStr); - if p = 0 then - begin - si := numstr; - sd := ''; - end else - begin - si := ProcessIntegerFormat(copy(numStr, 1, p-1), fs, AElements, AIndex, INT_TOKENS, false, false); // integer part of the mantissa - sd := ProcessIntegerFormat(copy(numStr, p+1, Length(numStr)), fs, AElements, id, DECS_TOKENS, true, false); // fractional part of the mantissa - end; - // Put all parts together... - Result := si + fs.DecimalSeparator + sd + se; - AIndex := i; - end; -end; - -function ProcessFracFormat(AValue: Double; const AFormatSettings: TFormatSettings; - ADigits: Integer; const AElements: TsNumFormatElements; - var AIndex: Integer): String; -var - fs: TFormatSettings absolute AFormatSettings; - frint, frnum, frdenom, maxdenom: Int64; - sfrint, sfrnum, sfrdenom: String; - sfrsym, sintnumspace, snumsymspace, ssymdenomspace: String; - i, numEl: Integer; -begin - sintnumspace := ''; - snumsymspace := ''; - ssymdenomspace := ''; - sfrsym := '/'; - if ADigits >= 0 then - maxDenom := Round(IntPower(10, ADigits)); - numEl := Length(AElements); - - i := AIndex; - if AElements[i].Token in (INT_TOKENS + [nftIntTh]) then begin - // Split-off integer - if (AValue >= 1) then - begin - frint := trunc(AValue); - AValue := frac(AValue); - end else - frint := 0; - if ADigits >= 0 then - FloatToFraction(AValue, maxdenom, frnum, frdenom) - else - begin - frdenom := -ADigits; - frnum := round(AValue*frdenom); - end; - sfrint := ProcessIntegerFormat(IntToStr(frint), fs, AElements, i, - INT_TOKENS + [nftIntTh], false, (AElements[i].Token = nftIntTh)); - while (i < numEl) and (AElements[i].Token in TERMINATING_TOKENS) do - begin - sintnumspace := sintnumspace + AElements[i].TextValue; - inc(i); - end; - end else - begin - // "normal" fraction - sfrint := ''; - if ADigits > 0 then - FloatToFraction(AValue, maxdenom, frnum, frdenom) - else - begin - frdenom := -ADigits; - frnum := round(AValue*frdenom); - end; - sintnumspace := ''; - end; - - // numerator and denominator - sfrnum := ProcessIntegerFormat(IntToStr(frnum), fs, AElements, i, - FRACNUM_TOKENS, false, false); - while (i < numEl) and (AElements[i].Token in TERMINATING_TOKENS) do - begin - snumsymspace := snumsymspace + AElements[i].TextValue; - inc(i); - end; - inc(i); // fraction symbol - while (i < numEl) and (AElements[i].Token in TERMINATING_TOKENS) do - begin - ssymdenomspace := ssymdenomspace + AElements[i].TextValue; - inc(i); - end; - - sfrdenom := ProcessIntegerFormat(IntToStr(frdenom), fs, AElements, i, - FRACDENOM_TOKENS, false, false); - AIndex := i+1; - - // Special cases - if (frnum = 0) then - begin - if sfrnum = '' then begin - sintnumspace := ''; - snumsymspace := ''; - ssymdenomspace := ''; - sfrdenom := ''; - sfrsym := ''; - end else - if trim(sfrnum) = '' then begin - sfrdenom := DupeString(' ', Length(sfrdenom)); - sfrsym := ' '; - end; - end; - if sfrint = '' then sintnumspace := ''; - - // Compose result string - Result := sfrnum + snumsymspace + sfrsym + ssymdenomspace + sfrdenom; - if (Trim(Result) = '') and (sfrint = '') then - sfrint := '0'; - if sfrint <> '' then - Result := sfrint + sintnumSpace + result; -end; - -function ProcessFloatFormat(AValue: Double; AFormatSettings: TFormatSettings; - const AElements: TsNumFormatElements; var AIndex: Integer): String; -var - fs: TFormatSettings absolute AFormatSettings; - numEl: Integer; - numStr, s: String; - p, i: Integer; - decs: Integer; - useThSep: Boolean; -begin - Result := ''; - numEl := Length(AElements); - - // Extract integer part - Result := IntToStr(trunc(AValue)); - useThSep := AElements[AIndex].Token = nftIntTh; - Result := ProcessIntegerFormat(Result, fs, AElements, AIndex, - (INT_TOKENS + [nftIntTh]), false, UseThSep); - - // Decimals - if (AIndex < numEl) and (AElements[AIndex].Token = nftDecSep) then - begin - inc(AIndex); - i := AIndex; - // Count decimal digits in format elements - decs := 0; - while (AIndex < numEl) and (AElements[AIndex].Token in DECS_TOKENS) do begin - inc(decs, AElements[AIndex].IntValue); - inc(AIndex); - end; - // Convert value to string - numstr := FloatToStrF(AValue, ffFixed, MaxInt, decs, fs); - p := Pos(fs.DecimalSeparator, numstr); - s := Copy(numstr, p+1, Length(numstr)); - s := ProcessIntegerFormat(s, fs, AElements, i, DECS_TOKENS, true, false); - if s <> '' then - Result := Result + fs.DecimalSeparator + s; - end; -end; - - -{@@ ---------------------------------------------------------------------------- - Converts a floating point number to a string as determined by the specified - number format parameters --------------------------------------------------------------------------------} -function ConvertFloatToStr(AValue: Double; AParams: TsNumFormatParams; - AFormatSettings: TFormatSettings): String; -var - fs: TFormatSettings absolute AFormatSettings; - sidx: Integer; - section: TsNumFormatSection; - i, el, numEl: Integer; - isNeg: Boolean; - yr, mon, day, hr, min, sec, ms: Word; - s: String; - digits: Integer; -begin - Result := ''; - if IsNaN(AValue) then - exit; - - if AParams = nil then - begin - Result := FloatToStrF(AValue, ffGeneral, 20, 20, fs); - exit; - end; - - sidx := 0; - if (AValue < 0) and (Length(AParams.Sections) > 1) then - sidx := 1; - if (AValue = 0) and (Length(AParams.Sections) > 2) then - sidx := 2; - isNeg := (AValue < 0); - AValue := abs(AValue); // section 0 adds the sign back, section 1 has the sign in the elements - section := AParams.Sections[sidx]; - numEl := Length(section.Elements); - - if nfkPercent in section.Kind then - AValue := AValue * 100.0; - if nfkHasFactor in section.Kind then - AValue := AValue * section.Factor; - if nfkTime in section.Kind then - DecodeTime(AValue, hr, min, sec, ms); - if nfkDate in section.Kind then - DecodeDate(AValue, yr, mon, day); - - el := 0; - while (el < numEl) do begin - if section.Elements[el].Token = nftGeneral then - begin - s := FloatToStrF(AValue, ffGeneral, 20, 20, fs); - if (sidx=0) and isNeg then s := '-' + s; - Result := Result + s; - end - else - // Integer token: can be the start of a number, exp, or mixed fraction format - // Cases with thousand separator are handled here as well. - if section.Elements[el].Token in (INT_TOKENS + [nftIntTh]) then begin - // Check for exponential format - if CheckExp(section.Elements, el) then - s := ProcessExpFormat(AValue, fs, section.Elements, el) - else - // Check for fraction format - if CheckFraction(section.Elements, el, digits) then - s := ProcessFracFormat(AValue, fs, digits, section.Elements, el) - else - // Floating-point or integer - s := ProcessFloatFormat(AValue, fs, section.Elements, el); - if (sidx = 0) and isNeg then s := '-' + s; - Result := Result + s; - Continue; - end - else - // Regular fraction (without integer being split off) - if (section.Elements[el].Token in FRACNUM_TOKENS) and - CheckFraction(section.Elements, el, digits) then - begin - s := ProcessFracFormat(AValue, fs, digits, section.Elements, el); - if (sidx = 0) and isNeg then s := '-' + s; - Result := Result + s; - Continue; - end - else - case section.Elements[el].Token of - nftSpace, nftText, nftEscaped, nftCurrSymbol, - nftSign, nftSignBracket, nftPercent: - Result := Result + section.Elements[el].TextValue; - - nftEmptyCharWidth: - Result := Result + ' '; - - nftDateTimeSep: - case section.Elements[el].TextValue of - '/': Result := Result + fs.DateSeparator; - ':': Result := Result + fs.TimeSeparator; - else Result := Result + section.Elements[el].TextValue; - end; - - nftDecSep: - Result := Result + fs.DecimalSeparator; - - nftThSep: - Result := Result + fs.ThousandSeparator; - - nftYear: - case section.Elements[el].IntValue of - 1, - 2: Result := Result + IfThen(yr mod 100 < 10, '0'+IntToStr(yr mod 100), IntToStr(yr mod 100)); - 4: Result := Result + IntToStr(yr); - end; - - nftMonth: - case section.Elements[el].IntValue of - 1: Result := Result + IntToStr(mon); - 2: Result := Result + IfThen(mon < 10, '0'+IntToStr(mon), IntToStr(mon)); - 3: Result := Result + fs.ShortMonthNames[mon]; - 4: Result := Result + fs.LongMonthNames[mon]; - end; - - nftDay: - case section.Elements[el].IntValue of - 1: result := result + IntToStr(day); - 2: result := Result + IfThen(day < 10, '0'+IntToStr(day), IntToStr(day)); - 3: Result := Result + fs.ShortDayNames[DayOfWeek(day)]; - 4: Result := Result + fs.LongDayNames[DayOfWeek(day)]; - end; - - nftHour: - begin - if section.Elements[el].IntValue < 0 then // This case is for nfTimeInterval - s := IntToStr(Int64(hr) + trunc(AValue) * 24) - else - if section.Elements[el].TextValue = 'AM' then // This tag is set in case of AM/FM format - begin - hr := hr mod 12; - if hr = 0 then hr := 12; - s := IntToStr(hr) - end else - s := IntToStr(hr); - if (abs(section.Elements[el].IntValue) = 2) and (Length(s) = 1) then - s := '0' + s; - Result := Result + s; - end; - - nftMinute: - begin - if section.Elements[el].IntValue < 0 then // case for nfTimeInterval - s := IntToStr(int64(min) + trunc(AValue) * 24 * 60) - else - s := IntToStr(min); - if (abs(section.Elements[el].IntValue) = 2) and (Length(s) = 1) then - s := '0' + s; - Result := Result + s; - end; - - nftSecond: - begin - if section.Elements[el].IntValue < 0 then // case for nfTimeInterval - s := IntToStr(Int64(sec) + trunc(AValue) * 24 * 60 * 60) - else - s := IntToStr(sec); - if (abs(section.Elements[el].IntValue) = 2) and (Length(s) = 1) then - s := '0' + s; - Result := Result + s; - end; - - nftMilliseconds: - case section.Elements[el].IntValue of - 1: Result := Result + IntToStr(ms div 100); - 2: Result := Result + Format('%02d', [ms div 10]); - 3: Result := Result + Format('%03d', [ms]); - end; - - nftAMPM: - begin - s := section.Elements[el].TextValue; - if lowercase(s) = 'ampm' then - s := IfThen(frac(AValue) < 0.5, fs.TimeAMString, fs.TimePMString) - else - begin - i := pos('/', s); - if i > 0 then - s := IfThen(frac(AValue) < 0.5, copy(s, 1, i-1), copy(s, i+1, Length(s))) - else - s := IfThen(frac(AValue) < 0.5, 'AM', 'PM'); - end; - Result := Result + s; - end; - end; // case - inc(el); - end; // while -end; - - { Modifying colors } { Next function are copies of GraphUtils to avoid a dependence on the Graphics unit. } diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas index d55fea005..c3743bf9f 100755 --- a/components/fpspreadsheet/xlsbiff2.pas +++ b/components/fpspreadsheet/xlsbiff2.pas @@ -161,7 +161,7 @@ var implementation uses - Math, fpsStrings, fpsReaderWriter, fpsPalette; + Math, fpsStrings, fpsReaderWriter, fpsPalette, fpsNumFormat; const { Excel record IDs } diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas index 61699fe17..6d4a951e6 100755 --- a/components/fpspreadsheet/xlsbiff5.pas +++ b/components/fpspreadsheet/xlsbiff5.pas @@ -214,7 +214,7 @@ var implementation uses - Math, fpsStrings, fpsStreams, fpsReaderWriter, fpsPalette; + Math, fpsStrings, fpsStreams, fpsReaderWriter, fpsPalette, fpsNumFormat; const { Excel record IDs } diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index 9598dd528..6dd8e26c6 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -258,7 +258,8 @@ implementation uses Math, lconvencoding, LazFileUtils, URIParser, - fpsStrings, fpsStreams, fpsReaderWriter, fpsPalette, fpsExprParser, xlsEscher; + fpsStrings, fpsStreams, fpsReaderWriter, fpsPalette, fpsNumFormat, + fpsExprParser, xlsEscher; const { Excel record IDs } diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index 05867064d..6f39cde26 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -565,7 +565,7 @@ implementation uses AVL_Tree, Math, Variants, - {%H-}fpspatches, fpsStrings, xlsConst, fpsrpn, fpsExprParser; + {%H-}fpspatches, fpsStrings, fpsNumFormat, xlsConst, fpsrpn, fpsExprParser; const { Helper table for rpn formulas: