paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
3750e3717d
lazarus-ccr/components/fpspreadsheet/source/common/fpsnumformat.pas

4013 lines
136 KiB
ObjectPascal
Raw Blame History

{@@ ----------------------------------------------------------------------------
Unit fpsNumFormat contains classes and procedures to analyze and process
<b>number formats</b>.
AUTHORS: Werner Pamler
LICENSE: See the file COPYING.modifiedLGPL.txt, included in the Lazarus
distribution, for details about the license.
-------------------------------------------------------------------------------}
unit fpsNumFormat;
{$ifdef fpc}
{$mode objfpc}{$H+}
{$endif}
interface
uses
Classes, SysUtils,
fpstypes;
const
psOK = 0;
psErrNoValidColorIndex = 1;
psErrNoValidCompareNumber = 2;
psErrUnknownInfoInBrackets = 3;
psErrConditionalFormattingNotSupported = 4;
psErrNoUsableFormat = 5;
psErrNoValidNumberFormat = 6;
psErrNoValidDateTimeFormat = 7;
psErrQuoteExpected = 8;
psErrMultipleCurrSymbols = 9;
psErrMultipleFracSymbols = 10;
psErrMultipleExpChars = 11;
psErrGeneralExpected = 12;
psAmbiguousSymbol = 13;
psErrNoValidTextFormat = 14;
type
{@@ Set of characters }
TsDecsChars = set of char;
{@@ Tokens used by the elements of the number format parser. If, e.g. a
format string is "0.000" then the number format parser detects the following
three tokens
- nftIntZeroDigit with integer value 1 (i.e. 1 zero-digit for the integer part)
- nftDecSep (i.e. decimal separator)
- ntZeroDecs with integer value 2 (i.e. 3 decimal places. }
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., '"€"' or '[$€]', stored in TextValue
nftCountry,
nftColor, // e.g., '[red]', Color in IntValue
nftCompareOp,
nftCompareValue,
nftSpace,
nftEscaped, // '\'
nftRepeat,
nftEmptyCharWidth,
nftTextFormat // '@'
);
{@@ Element of the parsed number format sequence. Each element is identified
by a token and has optional parameters stored as integer, float, and/or text. }
TsNumFormatElement = record
{@@ Token identifying the number format element }
Token: TsNumFormatToken;
{@@ Integer value associated with the number format element }
IntValue: Integer;
{@@ Floating point value associated with the number format element }
FloatValue: Double;
{@@ String value associated with the number format element }
TextValue: String;
end;
{@@ Array of parsed number format elements }
TsNumFormatElements = array of TsNumFormatElement;
{@@ Summary information classifying a number format section }
TsNumFormatKind = (nfkPercent, nfkExp, nfkCurrency, nfkFraction,
nfkDate, nfkTime, nfkTimeInterval, nfkText,
nfkHasColor, nfkHasThSep, nfkHasFactor);
{@@ Set of summary elements classifying and describing a number format section }
TsNumFormatKinds = set of TsNumFormatKind;
{@@ Number format string can be composed of several parts separated by a
semicolon. The number format parser extracts the format information into
individual sections for each part }
TsNumFormatSection = record
{@@ Parser number format elements used by this section }
Elements: TsNumFormatElements;
{@@ Summary information describing the section }
Kind: TsNumFormatKinds;
{@@ Reconstructed number format identifier for the built-in fps formats }
NumFormat: TsNumberFormat;
{@@ Number of decimal places used by the format string }
Decimals: Byte;
{@@ Factor by which a number will be multiplied before converting to string }
Factor: Double;
{@@ Digits to be used for the integer part of a fraction }
FracInt: Integer;
{@@ Digits to be used for the numerator part of a fraction }
FracNumerator: Integer;
{@@ Digits to be used for the denominator part of a fraction }
FracDenominator: Integer;
{@@ Currency string to be used in case of currency/accounting formats }
CurrencySymbol: String;
{@@ Color to be used when displaying the converted string }
Color: TsColor;
end;
{@@ Pointer to a parsed number format section }
PsNumFormatSection = ^TsNumFormatSection;
{@@ Array of parsed number format sections }
TsNumFormatSections = array of TsNumFormatSection;
{ TsNumFormatParams }
{@@ Describes a parsed number format and provides all the information to
convert a number to a number or date/time string. These data are created
by the number format parser from a format string. }
TsNumFormatParams = class(TObject)
private
protected
function GetNumFormat: TsNumberFormat; virtual;
function GetNumFormatStr: String; virtual;
public
{@@ Array of the format sections }
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 }
{@@ Class of number format parameters }
TsNumFormatParamsClass = class of TsNumFormatParams;
{@@ List containing parsed number format parameters }
TsNumFormatList = class(TFPList)
private
FOwnsData: Boolean;
function GetItem(AIndex: Integer): TsNumFormatParams;
procedure SetItem(AIndex: Integer; const AValue: TsNumFormatParams);
protected
FFormatSettings: TFormatSettings;
FClass: TsNumFormatParamsClass;
procedure AddBuiltinFormats; virtual;
public
constructor Create(AFormatSettings: TFormatSettings; AOwnsData: Boolean);
destructor Destroy; override;
function AddFormat(ASections: TsNumFormatSections): Integer; overload;
function AddFormat(AFormatStr: String): Integer; overload;
procedure Clear;
procedure Delete(AIndex: Integer);
function Find(ASections: TsNumFormatSections): Integer; overload;
function Find(AFormatstr: String): Integer; overload;
property Items[AIndex: Integer]: TsNumFormatParams read GetItem write SetItem; default;
end;
{ TsNumFormatParser }
TsNumFormatParser = class
private
FToken: Char;
FCurrent: PChar;
FStart: PChar;
FEnd: PChar;
FCurrSection: Integer;
FStatus: Integer;
function GetCurrencySymbol: String;
function GetDecimals: byte;
function GetFracDenominator: Integer;
function GetFracInt: Integer;
function GetFracNumerator: Integer;
function GetFormatString: String;
function GetNumFormat: TsNumberFormat;
function GetParsedSectionCount: Integer;
function GetParsedSections(AIndex: Integer): TsNumFormatSection;
procedure SetDecimals(AValue: Byte);
protected
FFormatSettings: TFormatSettings;
FSections: TsNumFormatSections;
{ Administration while scanning }
procedure AddElement(AToken: TsNumFormatToken; AText: String); overload;
procedure AddElement(AToken: TsNumFormatToken; AIntValue: Integer=0; AText: String = ''); overload;
procedure AddElement(AToken: TsNumFormatToken; AFloatValue: Double); overload;
procedure AddSection;
procedure DeleteElement(ASection, AIndex: Integer);
procedure InsertElement(ASection, AIndex: Integer; AToken: TsNumFormatToken; AText: String); overload;
procedure InsertElement(ASection, AIndex: Integer; AToken: TsNumFormatToken; AIntValue: Integer); overload;
procedure InsertElement(ASection, AIndex: Integer; AToken: TsNumFormatToken; AFloatValue: Double); overload;
function NextToken: Char;
function PrevToken: Char;
{ Scanning/parsing }
procedure ScanAMPM;
procedure ScanAndCount(ATestChar: Char; out ACount: Integer);
procedure ScanBrackets;
procedure ScanCondition(AFirstChar: Char);
procedure ScanCurrSymbol;
procedure ScanDateTime;
procedure ScanFormat;
procedure ScanGeneral;
procedure ScanNumber;
procedure ScanQuotedText;
// Main scanner
procedure Parse(const AFormatString: String);
{ Analysis while scanning }
procedure AnalyzeColor(AValue: String);
function AnalyzeCurrency(const AValue: String): Boolean;
{ Analysis after scanning }
// General
procedure CheckSections;
procedure CheckSection(ASection: Integer);
procedure FixMonthMinuteToken(var ASection: TsNumFormatSection);
// Format string
function BuildFormatString: String; virtual;
public
constructor Create(const AFormatString: String;
const AFormatSettings: TFormatSettings);
destructor Destroy; override;
procedure ClearAll;
function GetDateTimeCode(ASection: Integer): String;
function IsDateTimeFormat: Boolean;
function IsTimeFormat: Boolean;
procedure LimitDecimals;
property CurrencySymbol: String read GetCurrencySymbol;
property Decimals: Byte read GetDecimals write SetDecimals;
property FormatString: String read GetFormatString;
property FracDenominator: Integer read GetFracDenominator;
property FracInt: Integer read GetFracInt;
property FracNumerator: Integer read GetFracNumerator;
property NumFormat: TsNumberFormat read GetNumFormat;
property ParsedSectionCount: Integer read GetParsedSectionCount;
property ParsedSections[AIndex: Integer]: TsNumFormatSection read GetParsedSections;
property Status: Integer read FStatus;
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 ApplyTextFormat(AText: String; AParams: TsNumFormatParams): String;
function ConvertFloatToStr(AValue: Double; AParams: TsNumFormatParams;
AFormatSettings: TFormatSettings): String;
function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte;
function GeneralFormatFloat(AValue: Double;
AFormatSettings: TFormatSettings): String; inline;
function IsBoolValue(const AText, ATrueText, AFalseText: String;
out AValue: Boolean): Boolean;
function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean; overload;
function IsCurrencyFormat(ANumFormat: TsNumFormatParams): Boolean; overload;
function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; overload;
function IsDateTimeFormat(AFormatStr: String): Boolean; overload;
function IsDateTimeFormat(ANumFormat: TsNumFormatParams): Boolean; overload;
function IsDateTimeValue(AText: String; const AFormatSettings: TFormatSettings;
out ADateTime: TDateTime; out ANumFormat: TsNumberFormat): Boolean;
function IsDateFormat(ANumFormat: TsNumFormatParams): Boolean;
function IsTimeFormat(AFormat: TsNumberFormat): Boolean; overload;
function IsTimeFormat(AFormatStr: String): Boolean; overload;
function IsTimeFormat(ANumFormat: TsNumFormatParams): Boolean; overload;
function IsLongTimeFormat(AFormatStr: String; ATimeSeparator: char): Boolean; overload;
function IsNumberValue(AText: String; AutoDetectNumberFormat: Boolean;
const AFormatSettings: TFormatSettings; out ANumber: Double;
out ANumFormat: TsNumberFormat; out ADecimals: Integer;
out ACurrencySymbol, AWarning: String): Boolean;
function IsTimeIntervalFormat(ANumFormat: TsNumFormatParams): Boolean;
function IsTextFormat(ANumFormat: TsNumFormatParams): Boolean;
function MakeLongDateFormat(ADateFormat: String): String;
function MakeShortDateFormat(ADateFormat: String): String;
procedure MakeTimeIntervalMask(Src: String; var Dest: String);
function StripAMPM(const ATimeFormatString: String): String;
procedure InitFormatSettings(out AFormatSettings: TFormatSettings);
procedure ReplaceFormatSettings(var AFormatSettings: TFormatSettings;
const ADefaultFormats: TFormatSettings);
function CreateNumFormatParams(ANumFormatStr: String;
const AFormatSettings: TFormatSettings): TsNumFormatParams;
function ParamsOfNumFormatStr(ANumFormatStr: String;
const AFormatSettings: TFormatSettings; var AResult: TsNumFormatParams): Integer;
implementation
uses
StrUtils, Math, LazUTF8,
fpsUtils, fpsCurrency;
const
{@@ Array of format strings identifying the order of number and
currency symbol of a positive currency value. The number is expected at
index 0, the currency symbol at index 1 of the parameter array used by the
fpc Format() function. }
POS_CURR_FMT: array[0..3] of string = (
('%1:s%0:s'), // 0: $1
('%0:s%1:s'), // 1: 1$
('%1:s %0:s'), // 2: $ 1
('%0:s %1:s') // 3: 1 $
);
{@@ Array of format strings identifying the order of number and
currency symbol of a negative currency value. The sign is shown
as a dash character ("-") or by means of brackets. The number
is expected at index 0, the currency symbol at index 1 of the
parameter array for the fpc Format() function. }
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
{@@ Set of parsed number format tokens }
TsNumFormatTokenSet = set of TsNumFormatToken;
const
{@@ Set of tokens which terminate number information in a format string }
TERMINATING_TOKENS: TsNumFormatTokenSet =
[nftSpace, nftText, nftEscaped, nftPercent, nftCurrSymbol, nftSign, nftSignBracket];
{@@ Set of tokens which describe the integer part of a number format }
INT_TOKENS: TsNumFormatTokenSet =
[nftIntOptDigit, nftIntZeroDigit, nftIntSpaceDigit];
{@@ Set of tokens which describe the decimals of a number format }
DECS_TOKENS: TsNumFormatTokenSet =
[nftZeroDecs, nftOptDecs, nftSpaceDecs];
{@@ Set of tokens which describe the numerator of a fraction format }
FRACNUM_TOKENS: TsNumFormatTokenSet =
[nftFracNumOptDigit, nftFracNumZeroDigit, nftFracNumSpaceDigit];
{@@ Set of tokens which describe the denominator of a fraction format }
FRACDENOM_TOKENS: TsNumFormatTokenSet =
[nftFracDenomOptDigit, nftFracDenomZeroDigit, nftFracDenomSpaceDigit, nftFracDenom];
{@@ Set of tokens which describe the exponent in exponential formatting of a number }
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; // just to ease typing...
numEl: Integer;
numStr, s: String;
p, i: Integer;
decs: Integer;
useThSep: Boolean;
decsIndex: Integer;
begin
Result := '';
numEl := Length(AElements);
useThSep := AElements[AIndex].Token = nftIntTh;
// Find the element index of the decimal separator
i := AIndex;
while (i < numEl) and (AElements[i].Token <> nftDecSep) do
inc(i);
// No decimal separator --> format as integer
if i >= numEl then begin
Result := ProcessIntegerFormat(IntToStr(round(AValue)), fs, AElements, AIndex,
(INT_TOKENS + [nftIntTh]), false, useThSep);
exit;
end;
// There is a decimal separator. Get the count of decimal places.
decs := 0;
inc(i);
decsIndex := i;
while (i < numEl) and (AElements[i].Token in DECS_TOKENS) do begin
inc(decs, AElements[i].IntValue);
inc(i);
end;
// Convert value to string; this will do some rounding if required.
numstr := FloatToStrF(AValue, ffFixed, MaxInt, decs, fs);
// Process the integer part of the rounded number string
p := pos(fs.DecimalSeparator, numstr);
if p > 0 then s := copy(numstr, 1, p-1) else s := numstr;
Result := ProcessIntegerFormat(s, fs, AElements, AIndex,
(INT_TOKENS + [nftIntTh]), false, UseThSep);
// Process the fractional part of the rounded number string
if p > 0 then begin
s := Copy(numstr, p+1, Length(numstr));
AIndex := decsIndex;
s := ProcessIntegerFormat(s, fs, AElements, AIndex, 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 parameters 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 := GeneralFormatFloat(AValue, 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 := GeneralFormatFloat(AValue, 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(AValue)];
4: Result := Result + fs.LongDayNames[DayOfWeek(AValue)];
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;
function GeneralFormatFloat(AValue: Double;
AFormatSettings: TFormatSettings): String;
begin
Result := FloatToStrF(AValue, ffGeneral, 16, 16, AFormatSettings);
// 16 is for best rounding results
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 specified 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 parameters following)
@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 fpsTypes.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 fpsTypes.pas.
If < 0, the NegCurrFormat of the FormatSettings is used.
@param ACurrencySymbol String to identify 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
@example '"$"#,##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 + ']';
// ACurrencySymbol := '"' + ACurrencySymbol + '"'; // <-- not good for biff2
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. If the value is negative
then its absolute value is inserted literally as
as denominator.
@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
nfText:
Result := '@';
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 specified parsed number format section.
The format string is created according to Excel convention (which is understood
by ODS as well).
@param ASection Parsed section of number format elements as created by the
number format parser
@return Excel-compatible format string
-------------------------------------------------------------------------------}
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;
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;
nftTextFormat:
Result := '@';
end;
end;
end;
{@@ ----------------------------------------------------------------------------
Counts how many decimal places are coded into a given number format 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;
{@@ ----------------------------------------------------------------------------
Applies a text format to a text. The text placeholder is @. Supports
appending and prepending text.
-------------------------------------------------------------------------------}
function ApplyTextFormat(AText: String; AParams: TsNumFormatParams): String;
var
sct: TsNumFormatSection;
element: TsNumFormatElement;
i: Integer;
begin
Result := '';
for sct in AParams.Sections do
for i := 0 to High(sct.Elements) do begin
element := sct.Elements[i];
case element.Token of
nftTextFormat:
Result := Result + AText;
nftText:
Result := Result + element.TextValue;
end;
end;
end;
{@@ ----------------------------------------------------------------------------
Checks whether the specified text corresponds to a boolean value. For this,
it must match the specified TRUE and FALSE text phrases.
-------------------------------------------------------------------------------}
function IsBoolValue(const AText, ATrueText, AFalseText: String;
out AValue: Boolean): Boolean;
begin
if SameText(AText, ATrueText) then
begin
AValue := true;
Result := true;
end else
if SameText(AText, AFalseText) then
begin
AValue := false;
Result := true;
end else
Result := false;
end;
{@@ ----------------------------------------------------------------------------
Checks whether the given number format code is for currency,
i.e. requires a currency symbol.
@param AFormat Built-in number format identifier to be checked
@return True if AFormat is nfCurrency or nfCurrencyRed, false otherwise.
-------------------------------------------------------------------------------}
function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean;
begin
Result := AFormat in [nfCurrency, nfCurrencyRed];
end;
{@@ ----------------------------------------------------------------------------
Checks whether the specified number format parameters apply to currency values.
@param ANumFormat Number format parameters
@return True if Kind of the 1st format parameter section contains the
nfkCurrency elements; false otherwise
-------------------------------------------------------------------------------}
function IsCurrencyFormat(ANumFormat: TsNumFormatParams): Boolean;
begin
Result := (ANumFormat <> nil) and
(ANumFormat.Sections[0].Kind * [nfkCurrency] <> []);
end;
{@@ ----------------------------------------------------------------------------
Checks whether the given number format code is for date/time values.
@param AFormat Built-in number format identifier to be checked
@return True if AFormat is a date/time format (such as nfShortTime),
false otherwise
-------------------------------------------------------------------------------}
function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean;
begin
Result := AFormat in [nfShortDateTime, nfShortDate, nfLongDate,
nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM,
nfDayMonth, nfMonthYear, nfTimeInterval];
end;
{@@ ----------------------------------------------------------------------------
Checks whether the given string with formatting codes is for date/time values.
@param AFormatStr String with formatting codes to be checked.
@return True if AFormatStr is a date/time format string (such as 'hh:nn'),
false otherwise
-------------------------------------------------------------------------------}
function IsDateTimeFormat(AFormatStr: string): Boolean;
var
parser: TsNumFormatParser;
begin
parser := TsNumFormatParser.Create(AFormatStr, DefaultFormatSettings);
try
Result := parser.IsDateTimeFormat;
finally
parser.Free;
end;
end;
{@@ ----------------------------------------------------------------------------
Checks whether the specified number format parameters apply to date/time values.
@param ANumFormat Number format parameters
@return True if Kind of the 1st format parameter section contains the
nfkDate or nfkTime elements; false otherwise
-------------------------------------------------------------------------------}
function IsDateTimeFormat(ANumFormat: TsNumFormatParams): Boolean;
begin
Result := (ANumFormat <> nil) and
(ANumFormat.Sections[0].Kind * [nfkDate, nfkTime] <> []);
end;
{@@ ----------------------------------------------------------------------------
Checks whether the specified text corresponds to a date/time value and returns
true, its numerical value and its built-in numberformat if it is.
-------------------------------------------------------------------------------}
function IsDateTimeValue(AText: String; const AFormatSettings: TFormatSettings;
out ADateTime: TDateTime; out ANumFormat: TsNumberFormat): Boolean;
{ Test whether the text is formatted according to a built-in date/time format.
Converts the obtained date/time value back to a string and compares. }
function TestFormat(lNumFmt: TsNumberFormat): Boolean;
var
fmt: string;
begin
fmt := BuildDateTimeFormatString(lNumFmt, AFormatSettings);
Result := FormatDateTime(fmt, ADateTime, AFormatSettings) = AText;
if Result then ANumFormat := lNumFmt;
end;
begin
Result := TryStrToDateTime(AText, ADateTime, AFormatSettings);
if Result then
begin
ANumFormat := nfCustom;
if abs(ADateTime) > 1 then // this is most probably a date
begin
if TestFormat(nfShortDateTime) then
exit;
if TestFormat(nfLongDate) then
exit;
if TestFormat(nfShortDate) then
exit;
if TestFormat(nfMonthYear) then
exit;
if TestFormat(nfDayMonth) then
exit;
end else
begin // this case is time-only
if TestFormat(nfLongTimeAM) then
exit;
if TestFormat(nfLongTime) then
exit;
if TestFormat(nfShortTimeAM) then
exit;
if TestFormat(nfShortTime) then
exit;
end;
end;
end;
{@@ ----------------------------------------------------------------------------
Checks whether the specified number format parameters apply to a date value.
@param ANumFormat Number format parameters
@return True if Kind of the 1st format parameter section contains the
nfkDate, but no nfkTime tags; false otherwise
-------------------------------------------------------------------------------}
function IsDateFormat(ANumFormat: TsNumFormatParams): Boolean;
begin
Result := (ANumFormat <> nil) and
(ANumFormat.Sections[0].Kind * [nfkDate, nfkTime] = [nfkDate]);
end;
{@@ ----------------------------------------------------------------------------
Checks whether the given built-in number format code is for time values.
@param AFormat Built-in number format identifier to be checked
@return True if AFormat represents to a time-format, false otherwise
-------------------------------------------------------------------------------}
function IsTimeFormat(AFormat: TsNumberFormat): boolean;
begin
Result := AFormat in [nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM,
nfTimeInterval];
end;
{@@ ----------------------------------------------------------------------------
Checks whether the given string with formatting codes is for time values.
@param AFormatStr String with formatting codes to be checked
@return True if AFormatStr represents a time-format, false otherwise
-------------------------------------------------------------------------------}
function IsTimeFormat(AFormatStr: String): Boolean;
var
parser: TsNumFormatParser;
begin
parser := TsNumFormatParser.Create(AFormatStr, DefaultFormatSettings);
try
Result := parser.IsTimeFormat;
finally
parser.Free;
end;
end;
{@@ ----------------------------------------------------------------------------
Checks whether the specified number format parameters apply to time values.
@param ANumFormat Number format parameters
@return True if Kind of the 1st format parameter section contains the
nfkTime, but no nfkDate elements; false otherwise
-------------------------------------------------------------------------------}
function IsTimeFormat(ANumFormat: TsNumFormatParams): Boolean;
begin
Result := (ANumFormat <> nil) and
(ANumFormat.Sections[0].Kind * [nfkTime, nfkDate] = [nfkTime]);
end;
{@@ ----------------------------------------------------------------------------
Returns TRUE if the specified format string represents a long time format, i.e.
it contains two TimeSeparators.
-------------------------------------------------------------------------------}
function IsLongTimeFormat(AFormatStr: String; ATimeSeparator: Char): Boolean;
var
i, n: Integer;
begin
n := 0;
for i:=1 to Length(AFormatStr) do
if AFormatStr[i] = ATimeSeparator then inc(n);
Result := (n=2);
end;
{@@ ----------------------------------------------------------------------------
Checks whether the specified text corresponds to a numerical value. If it is
then the function result is TRUE, and the number value and its formatting
parameters are returned.
-------------------------------------------------------------------------------}
function IsNumberValue(AText: String; AutoDetectNumberFormat: Boolean;
const AFormatSettings: TFormatSettings;
out ANumber: Double; out ANumFormat: TsNumberFormat; out ADecimals: Integer;
out ACurrencySymbol, AWarning: String): Boolean;
var
p: Integer;
DecSep, ThousSep: Char;
begin
Result := false;
AWarning := '';
// To detect whether the text is a currency value we look for the currency
// string. If we find it, we delete it and convert the remaining string to
// a number.
ACurrencySymbol := AFormatSettings.CurrencyString;
if RemoveCurrencySymbol(ACurrencySymbol, AText) then
begin
if IsNegative(AText) then
begin
if AText = '' then
exit;
AText := '-' + AText;
end;
end else
ACurrencySymbol := '';
if AutoDetectNumberFormat then
Result := TryStrToFloatAuto(AText, ANumber, DecSep, ThousSep, AWarning)
else begin
Result := TryStrToFloat(AText, ANumber, AFormatSettings);
if Result then
begin
if pos(AFormatSettings.DecimalSeparator, AText) = 0
then DecSep := #0
else DecSep := AFormatSettings.DecimalSeparator;
if pos(AFormatSettings.ThousandSeparator, AText) = 0
then ThousSep := #0
else ThousSep := AFormatSettings.ThousandSeparator;
end;
end;
// Try to determine the number format
if Result then
begin
if ThousSep <> #0 then
ANumFormat := nfFixedTh
else
ANumFormat := nfGeneral;
// count number of decimal places and try to catch special formats
ADecimals := 0;
if DecSep <> #0 then
begin
// Go to the decimal separator and search towards the end of the string
p := pos(DecSep, AText) + 1;
while (p <= Length(AText)) do begin
// exponential format
if AText[p] in ['+', '-', 'E', 'e'] then
begin
ANumFormat := nfExp;
break;
end else
// percent format
if AText[p] = '%' then
begin
ANumFormat := nfPercentage;
break;
end else
begin
inc(p);
inc(ADecimals);
end;
end;
if (ADecimals > 0) and (ADecimals < 9) and (ANumFormat = nfGeneral) then
// "no formatting" assumed if there are "many" decimals
ANumFormat := nfFixed;
end else
begin
p := Length(AText);
while (p > 0) do begin
case AText[p] of
'%' : ANumFormat := nfPercentage;
'e', 'E': ANumFormat := nfExp;
else dec(p);
end;
break;
end;
end;
end else
ACurrencySymbol := '';
end;
{@@ ----------------------------------------------------------------------------
Checks whether the specified number format parameters is a time interval
format.
@param ANumFormat Number format parameters
@return True if Kind of the 1st format parameter section contains the
nfkTimeInterval elements; false otherwise
-------------------------------------------------------------------------------}
function IsTimeIntervalFormat(ANumFormat: TsNumFormatParams): Boolean;
begin
Result := (ANumFormat <> nil) and
(ANumFormat.Sections[0].Kind * [nfkTimeInterval] <> []);
end;
function IsTextFormat(ANumFormat: TsNumFormatParams): Boolean;
begin
Result := (ANumFormat <> nil) and
(ANumFormat.Sections[0].Kind = [nfkText]);
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;
{@@ ----------------------------------------------------------------------------
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;
{@@ ----------------------------------------------------------------------------
Initializes the FormatSettings of file a import/export parameters record to
default values which can be replaced by the FormatSettings of the
workbook's FormatSettings
-------------------------------------------------------------------------------}
procedure InitFormatSettings(out AFormatSettings: TFormatSettings);
var
i: Integer;
begin
with AFormatSettings do
begin
CurrencyFormat := Byte(-1);
NegCurrFormat := Byte(-1);
ThousandSeparator := #0;
DecimalSeparator := #0;
CurrencyDecimals := Byte(-1);
DateSeparator := #0;
TimeSeparator := #0;
ListSeparator := #0;
CurrencyString := '';
ShortDateFormat := '';
LongDateFormat := '';
TimeAMString := '';
TimePMString := '';
ShortTimeFormat := '';
LongTimeFormat := '';
for i:=1 to 12 do
begin
ShortMonthNames[i] := '';
LongMonthNames[i] := '';
end;
for i:=1 to 7 do
begin
ShortDayNames[i] := '';
LongDayNames[i] := '';
end;
TwoDigitYearCenturyWindow := Word(-1);
end;
end;
{@@ ----------------------------------------------------------------------------
Replaces in AFormatSettings all members marked as having default values (#0,
-1, '') by the corresponding values of the ADefaultFormats record
-------------------------------------------------------------------------------}
procedure ReplaceFormatSettings(var AFormatSettings: TFormatSettings;
const ADefaultFormats: TFormatSettings);
var
i: Integer;
begin
if AFormatSettings.CurrencyFormat = Byte(-1) then
AFormatSettings.CurrencyFormat := ADefaultFormats.CurrencyFormat;
if AFormatSettings.NegCurrFormat = Byte(-1) then
AFormatSettings.NegCurrFormat := ADefaultFormats.NegCurrFormat;
if AFormatSettings.ThousandSeparator = #0 then
AFormatSettings.ThousandSeparator := ADefaultFormats.ThousandSeparator;
if AFormatSettings.DecimalSeparator = #0 then
AFormatSettings.DecimalSeparator := ADefaultFormats.DecimalSeparator;
if AFormatSettings.CurrencyDecimals = Byte(-1) then
AFormatSettings.CurrencyDecimals := ADefaultFormats.CurrencyDecimals;
if AFormatSettings.DateSeparator = #0 then
AFormatSettings.DateSeparator := ADefaultFormats.DateSeparator;
if AFormatSettings.TimeSeparator = #0 then
AFormatSettings.TimeSeparator := ADefaultFormats.TimeSeparator;
if AFormatSettings.ListSeparator = #0 then
AFormatSettings.ListSeparator := ADefaultFormats.ListSeparator;
if AFormatSettings.CurrencyString = '' then
AFormatSettings.CurrencyString := ADefaultFormats.CurrencyString;
if AFormatSettings.ShortDateFormat = '' then
AFormatSettings.ShortDateFormat := ADefaultFormats.ShortDateFormat;
if AFormatSettings.LongDateFormat = '' then
AFormatSettings.LongDateFormat := ADefaultFormats.LongDateFormat;
if AFormatSettings.ShortTimeFormat = '' then
AFormatSettings.ShortTimeFormat := ADefaultFormats.ShortTimeFormat;
if AFormatSettings.LongTimeFormat = '' then
AFormatSettings.LongTimeFormat := ADefaultFormats.LongTimeFormat;
for i:=1 to 12 do
begin
if AFormatSettings.ShortMonthNames[i] = '' then
AFormatSettings.ShortMonthNames[i] := ADefaultFormats.ShortMonthNames[i];
if AFormatSettings.LongMonthNames[i] = '' then
AFormatSettings.LongMonthNames[i] := ADefaultFormats.LongMonthNames[i];
end;
for i:=1 to 7 do
begin
if AFormatSettings.ShortDayNames[i] = '' then
AFormatSettings.ShortDayNames[i] := ADefaultFormats.ShortDayNames[i];
if AFormatSettings.LongDayNames[i] = '' then
AFormatSettings.LongDayNames[i] := ADefaultFormats.LongDayNames[i];
end;
if AFormatSettings.TwoDigitYearCenturyWindow = Word(-1) then
AFormatSettings.TwoDigitYearCenturyWindow := ADefaultFormats.TwoDigitYearCenturyWindow;
end;
function CreateNumFormatParams(ANumFormatStr: String;
const AFormatSettings: TFormatSettings): TsNumFormatParams;
begin
Result := TsNumFormatParams.Create;
ParamsOfNumFormatStr(ANumFormatStr, AFormatSettings, result);
end;
function ParamsOfNumFormatStr(ANumFormatStr: String;
const AFormatSettings: TFormatSettings; var AResult: TsNumFormatParams): Integer;
var
parser: TsNumFormatParser;
begin
Assert(AResult <> nil);
if ANumFormatstr = 'General' then ANumFormatStr := '';
parser := TsNumFormatParser.Create(ANumFormatStr, AFormatSettings);
try
Result := parser.Status;
AResult.Sections := parser.FSections;
finally
parser.Free;
end;
end;
{==============================================================================}
{ TsNumFormatParams }
{==============================================================================}
{@@ ----------------------------------------------------------------------------
Deletes a parsed number format element from the specified format section.
@param ASectionIndex Index of the format section containing the element to
be deleted
@param AElementIndex Index of the format element to be deleted
-------------------------------------------------------------------------------}
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;
{@@ ----------------------------------------------------------------------------
Creates the built-in number format identifier from the parsed number format
sections and elements
@return Built-in number format identifer if the format is built into
fpspreadsheet, or nfCustom otherwise
@see TsNumFormat
-------------------------------------------------------------------------------}
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;
{@@ ----------------------------------------------------------------------------
Constructs the number format string from the parsed sections and elements.
The format symbols are selected according to Excel syntax.
@return Excel-compatible number format string.
-------------------------------------------------------------------------------}
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;
{@@ ----------------------------------------------------------------------------
Inserts a parsed format token into the specified format section before the
specified element.
@param ASectionIndex Index of the parsed format section into which the
token is to be inserted
@param AElementIndex Index of the format element before which the token
is to be inserted
@param AToken Parsed format token to be inserted
@see TsNumFormatToken
-------------------------------------------------------------------------------}
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;
{@@ ----------------------------------------------------------------------------
Checks whether the parsed format sections passed as a parameter are identical
to the interal section array.
@param ASections Array of parsed format sections to be compared with the
internal format sections
-------------------------------------------------------------------------------}
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;
{@@ ----------------------------------------------------------------------------
Defines the currency symbol used in the format params sequence
@param AValue String containing the currency symbol to be used in the
converted numbers
-------------------------------------------------------------------------------}
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;
{@@ ----------------------------------------------------------------------------
Adds or modifies parsed format tokens such that the specified number of
decimal places is displayed
@param AValue Number of decimal places to be shown
-------------------------------------------------------------------------------}
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;
{@@ ----------------------------------------------------------------------------
If AEnable is true a format section for negative numbers is added (or an
existing one is modified) such that negative numbers are displayed in red.
If AEnable is false the format tokens are modified such that negative values
are displayed in default color.
@param AEnable The format tokens are modified such as to display negative
values in red if AEnable is true.
-------------------------------------------------------------------------------}
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;
{@@ ----------------------------------------------------------------------------
Inserts a thousand separator token into the format elements at the
appropriate position, or removes it
@param AEnable A thousand separator is inserted if AEnable is true, or else
deleted.
-------------------------------------------------------------------------------}
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
inherited Create;
FClass := TsNumFormatParams;
FFormatSettings := AFormatSettings;
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;
begin
Result := Find(ASections);
if Result = -1 then begin
nfp := FClass.Create;
nfp.Sections := ASections;
Result := inherited Add(nfp);
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;
newSections: TsNumFormatSections;
i: Integer;
begin
parser := TsNumFormatParser.Create(AFormatStr, FFormatSettings);
try
SetLength(newSections, parser.ParsedSectionCount);
for i:=0 to High(newSections) do
newSections[i] := parser.ParsedSections[i];
Result := AddFormat(newSections);
finally
parser.Free;
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;
begin
for i := Count-1 downto 0 do Delete(i);
inherited;
end;
{@@ ----------------------------------------------------------------------------
Deletes the number format item having the specified index in the list.
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;
begin
if FOwnsData then
begin
p := GetItem(AIndex);
if p <> nil then p.Free;
end;
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;
begin
for Result := 0 to Count-1 do begin
nfp := GetItem(Result);
if nfp.SectionsEqualTo(ASections) then
exit;
end;
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;
begin
nfp := CreateNumFormatParams(AFormatStr, FFormatSettings);
if nfp = nil then
Result := -1
else
Result := Find(nfp.Sections);
end;
{@@ ----------------------------------------------------------------------------
Getter function returning the correct type of the list items
(i.e., 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
inherited Items[AIndex] := AValue;
end;
{==============================================================================}
{ TsNumFormatParser }
{==============================================================================}
{@@ ----------------------------------------------------------------------------
Creates a number format parser for analyzing a formatstring that has been
read from a spreadsheet file.
If ALocalized is true then the formatstring contains localized decimal
separator etc.
-------------------------------------------------------------------------------}
constructor TsNumFormatParser.Create(const AFormatString: String;
const AFormatSettings: TFormatSettings);
begin
inherited Create;
FFormatSettings := AFormatSettings;
Parse(AFormatString);
CheckSections;
if AFormatString = '' then FSections[0].NumFormat := nfGeneral;
end;
destructor TsNumFormatParser.Destroy;
begin
FSections := nil;
inherited Destroy;
end;
procedure TsNumFormatParser.AddElement(AToken: TsNumFormatToken; AText: String);
var
n: Integer;
begin
n := Length(FSections[FCurrSection].Elements);
SetLength(FSections[FCurrSection].Elements, n+1);
FSections[FCurrSection].Elements[n].Token := AToken;
FSections[FCurrSection].Elements[n].TextValue := AText;
end;
procedure TsNumFormatParser.AddElement(AToken: TsNumFormatToken;
AIntValue: Integer=0; AText: String = '');
var
n: Integer;
begin
n := Length(FSections[FCurrSection].Elements);
SetLength(FSections[FCurrSection].Elements, n+1);
FSections[FCurrSection].Elements[n].Token := AToken;
FSections[FCurrSection].Elements[n].IntValue := AIntValue;
FSections[FCurrSection].Elements[n].TextValue := AText;
end;
procedure TsNumFormatParser.AddElement(AToken: TsNumFormatToken; AFloatValue: Double); overload;
var
n: Integer;
begin
n := Length(FSections[FCurrSection].Elements);
SetLength(FSections[FCurrSection].Elements, n+1);
FSections[FCurrSection].Elements[n].Token := AToken;
FSections[FCurrSection].Elements[n].FloatValue := AFloatValue;
end;
procedure TsNumFormatParser.AddSection;
begin
FCurrSection := Length(FSections);
SetLength(FSections, FCurrSection + 1);
with FSections[FCurrSection] do
SetLength(Elements, 0);
end;
procedure TsNumFormatParser.AnalyzeColor(AValue: String);
var
n: Integer;
begin
AValue := lowercase(AValue);
// Colors
if AValue = 'red' then
AddElement(nftColor, ord(scRed))
else
if AValue = 'black' then
AddElement(nftColor, ord(scBlack))
else
if AValue = 'blue' then
AddElement(nftColor, ord(scBlue))
else
if AValue = 'white' then
AddElement(nftColor, ord(scWhite))
else
if AValue = 'green' then
AddElement(nftColor, ord(scGreen))
else
if AValue = 'cyan' then
AddElement(nftColor, ord(scCyan))
else
if AValue = 'magenta' then
AddElement(nftColor, ord(scMagenta))
else
if copy(AValue, 1, 5) = 'color' then begin
AValue := copy(AValue, 6, Length(AValue));
if not TryStrToInt(trim(AValue), n) then begin
FStatus := psErrNoValidColorIndex;
exit;
end;
AddElement(nftColor, n);
end else
FStatus := psErrUnknownInfoInBrackets;
end;
function TsNumFormatParser.AnalyzeCurrency(const AValue: String): Boolean;
begin
if (FFormatSettings.CurrencyString = '') then
Result := false
else
Result := CurrencyRegistered(AValue);
end;
{ Creates a formatstring for all sections.
Note: this implementation is only valid for the fpc and Excel dialects of
format string. }
function TsNumFormatParser.BuildFormatString: String;
var
i: Integer;
begin
if Length(FSections) > 0 then begin
Result := BuildFormatStringFromSection(FSections[0]);
for i:=1 to High(FSections) do
Result := Result + ';' + BuildFormatStringFromSection(FSections[i]);
end;
end;
procedure TsNumFormatParser.CheckSections;
var
i: Integer;
begin
for i:=0 to High(FSections) do
CheckSection(i);
if (Length(FSections) > 1) and (FSections[1].NumFormat = nfCurrencyRed) then
for i:=0 to High(FSections) do
if FSections[i].NumFormat = nfCurrency then
FSections[i].NumFormat := nfCurrencyRed;
end;
procedure TsNumFormatParser.CheckSection(ASection: Integer);
var
el, i: Integer;
section: PsNumFormatSection;
nfs, nfsTest: String;
nf: TsNumberFormat;
formats: set of TsNumberFormat;
isMonthMinute: Boolean;
begin
if FStatus <> psOK then
exit;
section := @FSections[ASection];
section^.Kind := [];
if (ASection = 0) and (Length(FSections) = 1) and (Length(section^.Elements) = 1)
and (section^.Elements[0].Token = nftGeneral)
then begin
section^.NumFormat := nfGeneral;
exit;
end;
i := 0;
isMonthMinute := false;
for el := 0 to High(section^.Elements) do
begin
case section^.Elements[el].Token of
nftZeroDecs:
section^.Decimals := section^.Elements[el].IntValue;
nftIntZeroDigit, nftIntOptDigit, nftIntSpaceDigit:
i := section^.Elements[el].IntValue;
nftFracNumSpaceDigit, nftFracNumZeroDigit:
section^.FracNumerator := section^.Elements[el].IntValue;
nftFracDenomSpaceDigit, nftFracDenomZeroDigit:
section^.FracDenominator := section^.Elements[el].IntValue;
nftFracDenom:
section^.FracDenominator := -section^.Elements[el].IntValue;
nftPercent:
section^.Kind := section^.Kind + [nfkPercent];
nftExpChar:
if (nfkExp in section^.Kind) then
FStatus := psErrMultipleExpChars
else
section^.Kind := section^.Kind + [nfkExp];
nftFactor:
if section^.Elements[el].IntValue <> 0 then
begin
section^.Elements[el].FloatValue := IntPower(10, -3*section^.Elements[el].IntValue);
section^.Factor := section^.Elements[el].FloatValue;
section^.Kind := section^.Kind + [nfkHasFactor];
end;
nftFracSymbol:
if (nfkFraction in section^.Kind) then
FStatus := psErrMultipleFracSymbols
else
begin
section^.Kind := section^.Kind + [nfkFraction];
section^.FracInt := i;
end;
nftCurrSymbol:
begin
if (nfkCurrency in section^.Kind) then
FStatus := psErrMultipleCurrSymbols
else begin
section^.Kind := section^.Kind + [nfkCurrency];
section^.CurrencySymbol := section^.Elements[el].TextValue;
end;
end;
nftYear, nftMonth, nftDay:
section^.Kind := section^.Kind + [nfkDate];
nftHour, nftMinute, nftSecond, nftMilliseconds:
begin
section^.Kind := section^.Kind + [nfkTime];
if section^.Elements[el].IntValue < 0 then
section^.Kind := section^.Kind + [nfkTimeInterval];
end;
nftMonthMinute:
isMonthMinute := true;
nftColor:
begin
section^.Kind := section^.Kind + [nfkHasColor];
section^.Color := section^.Elements[el].IntValue;
end;
nftIntTh:
section^.Kind := section^.Kind + [nfkHasThSep];
nftTextFormat:
section^.Kind := section^.Kind + [nfkText];
end;
end; // for
if FStatus <> psOK then
exit;
if (section^.Kind * [nfkDate, nfkTime] <> []) and
(section^.Kind * [nfkPercent, nfkExp, nfkCurrency, nfkFraction] <> []) then
begin
FStatus := psErrNoValidDateTimeFormat;
exit;
end;
if (Length(FSections) = 1) and (section^.Kind = [nfkText]) then begin
section^.NumFormat := nfText;
exit;
end;
section^.NumFormat := nfCustom;
if (section^.Kind * [nfkDate, nfkTime] <> []) or isMonthMinute then
begin
FixMonthMinuteToken(section^);
nfs := GetFormatString;
if (nfkTimeInterval in section^.Kind) then
section^.NumFormat := nfTimeInterval
else
begin
formats := [nfShortDateTime, nfLongDate, nfShortDate, nfLongTime,
nfShortTime, nfLongTimeAM, nfShortTimeAM, nfDayMonth, nfMonthYear];
for nf in formats do
begin
nfsTest := BuildDateTimeFormatString(nf, FFormatSettings);
if Length(nfsTest) = Length(nfs) then
begin
if SameText(nfs, nfsTest) then
begin
section^.NumFormat := nf;
break;
end;
for i := 1 to Length(nfsTest) do
case nfsTest[i] of
'/': if not (nf in [nfLongTimeAM, nfShortTimeAM]) then
nfsTest[i] := FFormatSettings.DateSeparator;
':': nfsTest[i] := FFormatSettings.TimeSeparator;
'n': nfsTest[i] := 'm';
end;
if SameText(nfs, nfsTest) then
begin
section^.NumFormat := nf;
break;
end;
end;
end;
end;
end else
begin
nfs := GetFormatString;
nfsTest := BuildFractionFormatString(section^.FracInt > 0, section^.FracNumerator, section^.FracDenominator);
if sameText(nfs, nfsTest) then
section^.NumFormat := nfFraction
else
begin
formats := [nfFixed, nfFixedTh, nfPercentage, nfExp];
for nf in formats do begin
nfsTest := BuildNumberFormatString(nf, FFormatSettings, section^.Decimals);
if SameText(nfs, nfsTest) then
begin
section^.NumFormat := nf;
break;
end;
end;
end;
if (section^.NumFormat = nfCustom) and (nfkCurrency in section^.Kind) then
begin
section^.NumFormat := nfCurrency;
if section^.Color = scRed then
section^.NumFormat := nfCurrencyRed;
end;
end;
end;
procedure TsNumFormatParser.ClearAll;
var
i, j: Integer;
begin
for i:=0 to Length(FSections)-1 do begin
for j:=0 to Length(FSections[i].Elements) do
if FSections[i].Elements <> nil then
FSections[i].Elements[j].TextValue := '';
FSections[i].Elements := nil;
FSections[i].CurrencySymbol := '';
end;
FSections := nil;
end;
procedure TsNumFormatParser.DeleteElement(ASection, AIndex: Integer);
var
i, n: Integer;
begin
n := Length(FSections[ASection].Elements);
for i:= AIndex+1 to n-1 do
FSections[ASection].Elements[i-1] := FSections[ASection].Elements[i];
SetLength(FSections[ASection].Elements, n-1);
end;
{ Identify the ambiguous "m" token ("month" or "minute") }
procedure TsNumFormatParser.FixMonthMinuteToken(var ASection: TsNumFormatSection);
var
i, j: Integer;
// Finds the previous date/time element skipping spaces, date/time sep etc.
function PrevDateTimeElement(j: Integer): Integer;
begin
Result := -1;
dec(j);
while (j >= 0) do begin
with ASection.Elements[j] do
if Token in [nftYear, nftMonth, nftDay, nftHour, nftMinute, nftSecond] then
begin
Result := j;
exit;
end;
dec(j);
end;
end;
// Finds the next date/time element skipping spaces, date/time sep etc.
function NextDateTimeElement(j: Integer): Integer;
begin
Result := -1;
inc(j);
while (j < Length(ASection.Elements)) do begin
with ASection.Elements[j] do
if Token in [nftYear, nftMonth, nftDay, nftHour, nftMinute, nftSecond] then
begin
Result := j;
exit;
end;
inc(j);
end;
end;
begin
for i:=0 to High(ASection.Elements) do
begin
// Find index of nftMonthMinute token...
if ASection.Elements[i].Token = nftMonthMinute then begin
// ... and, using its neighbors, decide whether it is a month or a minute.
j := NextDateTimeElement(i);
if j <> -1 then
case ASection.Elements[j].Token of
nftDay, nftYear:
begin
ASection.Elements[i].Token := nftMonth;
Continue;
end;
nftSecond:
begin
ASection.Elements[i].Token := nftMinute;
Continue;
end;
end;
j := PrevDateTimeElement(i);
if j <> -1 then
case ASection.Elements[j].Token of
nftDay, nftYear:
begin
ASection.Elements[i].Token := nftMonth;
Continue;
end;
nftHour:
begin
ASection.Elements[i].Token := nftMinute;
Continue;
end;
end;
// If we get here the token is isolated. In this case we assume
// that it is a month - that's the way Excel does it when reading files
// (for editing of a worksheet, however, Excel distinguishes between
// uppercase "M" for "month" and lowercase "m" for "minute".)
ASection.Elements[i].Token := nftMonth;
Include(ASection.Kind, nfkDate);
end;
end;
end;
procedure TsNumFormatParser.InsertElement(ASection, AIndex: Integer;
AToken: TsNumFormatToken; AText: String);
var
i, n: Integer;
begin
n := Length(FSections[ASection].Elements);
SetLength(FSections[ASection].Elements, n+1);
for i:= n-1 downto AIndex+1 do
FSections[ASection].Elements[i+1] := FSections[ASection].Elements[i];
FSections[ASection].Elements[AIndex+1].Token := AToken;
FSections[ASection].Elements[AIndex+1].TextValue := AText;
end;
procedure TsNumFormatParser.InsertElement(ASection, AIndex: Integer;
AToken: TsNumFormatToken; AIntValue: Integer);
var
i, n: Integer;
begin
n := Length(FSections[ASection].Elements);
SetLength(FSections[ASection].Elements, n+1);
for i:= n-1 downto AIndex+1 do
FSections[ASection].Elements[i+1] := FSections[ASection].Elements[i];
FSections[ASection].Elements[AIndex+1].Token := AToken;
FSections[ASection].Elements[AIndex+1].IntValue := AIntValue;
end;
procedure TsNumFormatParser.InsertElement(ASection, AIndex: Integer;
AToken: TsNumFormatToken; AFloatValue: Double);
var
i, n: Integer;
begin
n := Length(FSections[ASection].Elements);
SetLength(FSections[ASection].Elements, n+1);
for i:= n-1 downto AIndex+1 do
FSections[ASection].Elements[i+1] := FSections[ASection].Elements[i];
FSections[ASection].Elements[AIndex+1].Token := AToken;
FSections[ASection].Elements[AIndex+1].FloatValue := AFloatValue;
end;
function TsNumFormatParser.GetFormatString: String;
begin
Result := BuildFormatString;
end;
{ Extracts the currency symbol form the formatting sections. It is assumed that
all two or three sections of the currency/accounting format use the same
currency symbol, otherwise it would be custom format anyway which ignores
the currencysymbol value. }
function TsNumFormatParser.GetCurrencySymbol: String;
begin
if Length(FSections) > 0 then
Result := FSections[0].CurrencySymbol
else
Result := '';
end;
{ Creates a string which summarizes the date/time formats in the given section.
The string contains a 'y' for a nftYear, a 'm' for a nftMonth, a
'd' for a nftDay, a 'h' for a nftHour, a 'n' for a nftMinute, a 's' for a
nftSeconds, and a 'z' for a nftMilliseconds token. The order is retained.
Needed for biff2 }
function TsNumFormatParser.GetDateTimeCode(ASection: Integer): String;
var
i: Integer;
begin
Result := '';
if ASection < Length(FSections) then
with FSections[ASection] do begin
i := 0;
while i < Length(Elements) do begin
case Elements[i].Token of
nftYear : Result := Result + 'y';
nftMonth : Result := Result + 'm';
nftDay : Result := Result + 'd';
nftHour : Result := Result + 'h';
nftMinute : Result := Result + 'n';
nftSecond : Result := Result + 's';
nftMilliSeconds: Result := Result + 'z';
end;
inc(i);
end;
end;
end;
{ Extracts the number of decimals from the sections. Since they are needed only
for default formats having only a single section, only the first section is
considered. In case of currency/accounting having two or three sections, it is
assumed that all sections have the same decimals count, otherwise it would not
be a standard format. }
function TsNumFormatParser.GetDecimals: Byte;
begin
if Length(FSections) > 0 then
Result := FSections[0].Decimals
else
Result := 0;
end;
function TsNumFormatParser.GetFracDenominator: Integer;
begin
if Length(FSections) > 0 then
Result := FSections[0].FracDenominator
else
Result := 0;
end;
function TsNumFormatParser.GetFracInt: Integer;
begin
if Length(FSections) > 0 then
Result := FSections[0].FracInt
else
Result := 0;
end;
function TsNumFormatParser.GetFracNumerator: Integer;
begin
if Length(FSections) > 0 then
Result := FSections[0].FracNumerator
else
Result := 0;
end;
{ Tries to extract a common builtin number format from the sections. If there
are multiple sections, it is always a custom format, except for Currency and
Accounting. }
function TsNumFormatParser.GetNumFormat: TsNumberFormat;
begin
if Length(FSections) = 0 then
result := nfGeneral
else begin
Result := FSections[0].NumFormat;
if (Result = nfCurrency) then begin
if Length(FSections) = 2 then begin
Result := FSections[1].NumFormat;
if FSections[1].CurrencySymbol <> FSections[0].CurrencySymbol then begin
Result := nfCustom;
exit;
end;
if (FSections[0].NumFormat in [nfCurrency, nfCurrencyRed]) and
(FSections[1].NumFormat in [nfCurrency, nfCurrencyRed])
then
exit;
end else
if Length(FSections) = 3 then begin
Result := FSections[1].NumFormat;
if (FSections[0].CurrencySymbol <> FSections[1].CurrencySymbol) or
(FSections[1].CurrencySymbol <> FSections[2].CurrencySymbol)
then begin
Result := nfCustom;
exit;
end;
if (FSections[0].NumFormat in [nfCurrency, nfCurrencyRed]) and
(FSections[1].NumFormat in [nfCurrency, nfCurrencyRed]) and
(FSections[2].NumFormat in [nfCurrency, nfCurrencyRed])
then
exit;
end;
Result := nfCustom;
exit;
end;
if Length(FSections) > 1 then
Result := nfCustom;
end;
end;
function TsNumFormatParser.GetParsedSectionCount: Integer;
begin
Result := Length(FSections);
end;
function TsNumFormatParser.GetParsedSections(AIndex: Integer): TsNumFormatSection;
begin
Result := FSections[AIndex];
end;
{
function TsNumFormatParser.GetTokenIntValueAt(AToken: TsNumFormatToken;
ASection, AIndex: Integer): Integer;
begin
if IsTokenAt(AToken, ASection, AIndex) then
Result := FSections[ASection].Elements[AIndex].IntValue
else
Result := -1;
end;
}
{ Returns true if the format elements contain at least one date/time token }
function TsNumFormatParser.IsDateTimeFormat: Boolean;
var
section: TsNumFormatSection;
begin
for section in FSections do
if section.Kind * [nfkDate, nfkTime] <> [] then
begin
Result := true;
exit;
end;
Result := false;
end;
{
function TsNumFormatParser.IsNumberAt(ASection, AIndex: Integer;
out ANumFormat: TsNumberFormat; out ADecimals: Byte;
out ANextIndex: Integer): Boolean;
var
token: TsNumFormatToken;
begin
if (ASection > High(FSections)) or (AIndex > High(FSections[ASection].Elements))
then begin
Result := false;
ANextIndex := AIndex;
exit;
end;
Result := true;
ANumFormat := nfCustom;
ADecimals := 0;
token := FSections[ASection].Elements[AIndex].Token;
if token in [nftFracNumOptDigit, nftFracNumZeroDigit, nftFracNumSpaceDigit,
nftFracDenomOptDigit, nftFracDenomZeroDigit, nftFracDenomSpaceDigit] then
begin
ANumFormat := nfFraction;
ANextIndex := AIndex + 1;
exit;
end;
if (token = nftIntTh) and (FSections[ASection].Elements[AIndex].IntValue = 1) then // '#,##0'
ANumFormat := nfFixedTh
else
if (token = nftIntZeroDigit) and (FSections[ASection].Elements[AIndex].IntValue = 1) then // '0'
ANumFormat := nfFixed;
if (token in [nftIntTh, nftIntZeroDigit, nftIntOptDigit, nftIntSpaceDigit]) then
begin
if IsTokenAt(nftDecSep, ASection, AIndex+1) then
begin
if AIndex + 2 < Length(FSections[ASection].Elements) then
begin
token := FSections[ASection].Elements[AIndex+2].Token;
if (token in [nftZeroDecs, nftOptDecs, nftSpaceDecs]) then
begin
ANextIndex := AIndex + 3;
ADecimals := FSections[ASection].Elements[AIndex+2].IntValue;
if (token <> nftZeroDecs) then
ANumFormat := nfCustom;
exit;
end;
end;
end else
if IsTokenAt(nftSpace, ASection, AIndex+1) then
begin
ANumFormat := nfFraction;
ANextIndex := AIndex + 1;
exit;
end else
begin
ANextIndex := AIndex + 1;
exit;
end;
end;
ANextIndex := AIndex;
Result := false;
end;
function TsNumFormatParser.IsTextAt(AText: String; ASection, AIndex: Integer): Boolean;
begin
Result := IsTokenAt(nftText, ASection, AIndex) and
(FSections[ASection].Elements[AIndex].TextValue = AText);
end;
}
{ Returns true if the format elements contain only time, no date tokens. }
function TsNumFormatParser.IsTimeFormat: Boolean;
var
section: TsNumFormatSection;
begin
for section in FSections do
if (nfkTime in section.Kind) then
begin
Result := true;
exit;
end;
Result := false;
end;
{
function TsNumFormatParser.IsTokenAt(AToken: TsNumFormatToken;
ASection, AIndex: Integer): Boolean;
begin
Result := (ASection < Length(FSections)) and
(AIndex < Length(FSections[ASection].Elements)) and
(FSections[ASection].Elements[AIndex].Token = AToken);
end;
}
{ Limits the decimals to 0 or 2, as required by Excel2. }
procedure TsNumFormatParser.LimitDecimals;
var
i, j: Integer;
begin
for j:=0 to High(FSections) do
for i:=0 to High(FSections[j].Elements) do
if FSections[j].Elements[i].Token = nftZeroDecs then
if FSections[j].Elements[i].IntValue > 0 then
FSections[j].Elements[i].IntValue := 2;
end;
function TsNumFormatParser.NextToken: Char;
begin
if FCurrent < FEnd then begin
inc(FCurrent);
Result := FCurrent^;
end else
Result := #0;
end;
function TsNumFormatParser.PrevToken: Char;
begin
if FCurrent > nil then begin
dec(FCurrent);
Result := FCurrent^;
end else
Result := #0;
end;
procedure TsNumFormatParser.Parse(const AFormatString: String);
begin
FStatus := psOK;
AddSection;
if (AFormatString = '') then
begin
AddElement(nftGeneral);
exit;
end;
FStart := @AFormatString[1];
FEnd := FStart + Length(AFormatString);
FCurrent := FStart;
FToken := FCurrent^;
while (FCurrent < FEnd) and (FStatus = psOK) do begin
case FToken of
'G','g': ScanGeneral;
'[': ScanBrackets;
'"': ScanQuotedText;
':': AddElement(nftDateTimeSep, ':');
';': AddSection;
else ScanFormat;
end;
FToken := NextToken;
end;
end;
{ Scans an AM/PM sequence (or AMPM or A/P).
At exit, cursor is a next character }
procedure TsNumFormatParser.ScanAMPM;
var
s: String;
el: Integer;
begin
s := '';
while (FCurrent < FEnd) do begin
if (FToken in ['A', 'a', 'P', 'p', 'm', 'M', '/']) then
s := s + FToken
else
break;
FToken := NextToken;
end;
if s <> '' then
begin
AddElement(nftAMPM, s);
// Tag the hour element for AM/PM format needed
el := High(FSections[FCurrSection].Elements)-1;
for el := High(FSections[FCurrSection].Elements)-1 downto 0 do
if FSections[FCurrSection].Elements[el].Token = nftHour then
begin
FSections[FCurrSection].Elements[el].TextValue := 'AM';
break;
end;
end;
end;
{ Counts the number of characters equal to ATestChar. Stops at the next
different character. This is also where the cursor is at exit. }
procedure TsNumFormatParser.ScanAndCount(ATestChar: Char; out ACount: Integer);
begin
ACount := 0;
if FToken <> ATestChar then
exit;
repeat
inc(ACount);
FToken := NextToken;
until (FToken <> ATestChar) or (FCurrent >= FEnd);
end;
{ Extracts the text between square brackets. This can be
- a time duration like [hh]
- a condition, like [>= 2.0]
- a currency symbol like [$€-409]
- a color like [red] or [color25]
The procedure is left with the cursor at ']' }
procedure TsNumFormatParser.ScanBrackets;
var
s: String;
n: Integer;
prevtok: Char;
isText: Boolean;
begin
s := '';
isText := false;
FToken := NextToken; // Cursor was at '['
while (FCurrent < FEnd) and (FStatus = psOK) do begin
case FToken of
'h', 'H', 'm', 'M', 'n', 'N', 's', 'S':
if isText then
s := s + FToken
else
begin
prevtok := FToken;
ScanAndCount(FToken, n);
if (FToken in [']', #0]) then begin
case prevtok of
'h', 'H' : AddElement(nftHour, -n);
'm', 'M', 'n', 'N': AddElement(nftMinute, -n);
's', 'S' : AddElement(nftSecond, -n);
end;
break;
end else
FStatus := psErrUnknownInfoInBrackets;
end;
'<', '>', '=':
begin
ScanCondition(FToken);
if FToken = ']' then
break
else
FStatus := psErrUnknownInfoInBrackets;
end;
'$':
begin
ScanCurrSymbol;
if FToken = ']' then
break
else
FStatus := psErrUnknownInfoInBrackets;
end;
']':
begin
AnalyzeColor(s);
break;
end;
else
s := s + FToken;
isText := true;
end;
FToken := NextToken;
end;
end;
{ Scans a condition like [>=2.0]. Starts after the "[" and ends before at "]".
Returns first character after the number (spaces allowed). }
procedure TsNumFormatParser.ScanCondition(AFirstChar: Char);
var
s: String;
// op: TsCompareOperation;
value: Double;
res: Integer;
begin
s := AFirstChar;
FToken := NextToken;
if FToken in ['>', '<', '='] then s := s + FToken else FToken := PrevToken;
{
if s = '=' then op := coEqual else
if s = '<>' then op := coNotEqual else
if s = '<' then op := coLess else
if s = '>' then op := coGreater else
if s = '<=' then op := coLessEqual else
if s = '>=' then op := coGreaterEqual
else begin
FStatus := psErrUnknownInfoInBrackets;
FToken := #0;
exit;
end;
}
while (FToken = ' ') and (FCurrent < FEnd) do
FToken := NextToken;
if FCurrent >= FEnd then begin
FStatus := psErrUnknownInfoInBrackets;
FToken := #0;
exit;
end;
s := FToken;
while (FCurrent < FEnd) and (FToken in ['+', '-', '.', '0'..'9']) do begin
FToken := NextToken;
s := s + FToken;
end;
val(s, value, res);
if res <> 0 then begin
FStatus := psErrUnknownInfoInBrackets;
FToken := #0;
exit;
end;
while (FCurrent < FEnd) and (FToken = ' ') do
FToken := NextToken;
if FToken = ']' then
AddElement(nftCompareOp, value)
else begin
FStatus := psErrUnknownInfoInBrackets;
FToken := #0;
end;
end;
{ Scans to end of a symbol like [$EUR-409], starting after the $ and ending at
the "]".
After the "$" follows the currency symbol, after the "-" country information }
procedure TsNumFormatParser.ScanCurrSymbol;
var
s: String;
begin
s := '';
FToken := NextToken;
while (FCurrent < FEnd) and not (FToken in ['-', ']']) do begin
s := s + FToken;
FToken := NextToken;
end;
if s <> '' then
AddElement(nftCurrSymbol, s);
if FToken <> ']' then begin
FToken := NextToken;
while (FCurrent < FEnd) and (FToken <> ']') do begin
s := s + FToken;
FToken := NextToken;
end;
if s <> '' then
AddElement(nftCountry, s);
end;
end;
{ Scans a date/time format. Procedure is left with the cursor at the last char
of the date/time format. }
procedure TsNumFormatParser.ScanDateTime;
var
n: Integer;
token: Char;
begin
while (FCurrent < FEnd) and (FStatus = psOK) do begin
case FToken of
'\': // means that the next character is taken literally
begin
FToken := NextToken; // skip the "\"...
AddElement(nftEscaped, FToken);
FToken := NextToken;
end;
'Y', 'y':
begin
ScanAndCount(FToken, n);
AddElement(nftYear, n);
end;
'm', 'M', 'n', 'N':
begin
token := FToken;
ScanAndCount(FToken, n);
AddElement(nftMonthMinute, n, token); // Decide on minute or month later
end;
'D', 'd':
begin
ScanAndCount(FToken, n);
AddElement(nftDay, n);
end;
'H', 'h':
begin
ScanAndCount(FToken, n);
AddElement(nftHour, n);
end;
'S', 's':
begin
ScanAndCount(FToken, n);
AddElement(nftSecond, n);
end;
'/', ':':
begin
AddElement(nftDateTimeSep, FToken);
FToken := NextToken;
end;
'.':
begin
token := NextToken;
if token in ['z', '0'] then begin
AddElement(nftDecSep, FToken);
FToken := NextToken;
ScanAndCount(FToken, n);
AddElement(nftMilliseconds, n);
end else begin
AddElement(nftDateTimeSep, FToken);
FToken := token;
end;
end;
'[':
begin
ScanBrackets;
FToken := NextToken;
end;
'A', 'a':
ScanAMPM;
',', '-':
begin
AddElement(nftText, FToken);
FToken := NextToken;
end
else
// char pointer must be at end of date/time mask.
FToken := PrevToken;
Exit;
end;
end;
end;
procedure TsNumFormatParser.ScanFormat;
var
done: Boolean;
n: Integer;
uch: Cardinal;
begin
done := false;
while (FCurrent < FEnd) and (FStatus = psOK) and (not done) do begin
case FToken of
'\': // Excel: add next character literally
begin
FToken := NextToken;
AddElement(nftText, FToken);
end;
'*': // Excel: repeat next character to fill cell. For accounting format.
begin
FToken := NextToken;
AddElement(nftRepeat, FToken);
end;
'_': // Excel: Leave width of next character empty
begin
FToken := NextToken;
uch := UTF8CharacterToUnicode(FCurrent, n);
if n > 1 then
begin
AddElement(nftEmptyCharWidth, UnicodeToUTF8(uch));
inc(FCurrent, n-1);
FToken := NextToken;
Continue;
end else
AddElement(nftEmptyCharWidth, FToken);
end;
'@': // Excel: Indicates text format
begin
AddElement(nftTextFormat, FToken);
end;
'"':
ScanQuotedText;
'(', ')':
AddElement(nftSignBracket, FToken);
'0', '#', '?', '.', ',', '-':
ScanNumber;
'y', 'Y', 'm', 'M', 'd', 'D', 'h', 'N', 'n', 's':
ScanDateTime;
'[':
ScanBrackets;
' ':
AddElement(nftSpace, FToken);
'A', 'a':
begin
ScanAMPM;
FToken := PrevToken;
end;
'G', 'g':
ScanGeneral;
';': // End of the section. Important: Cursor must stay on ';'
begin
AddSection;
Exit;
end;
else
uch := UTF8CharacterToUnicode(FCurrent, n);
if n > 1 then
begin
AddElement(nftText, UnicodeToUTF8(uch));
inc(FCurrent, n-1);
end else
AddElement(nftText, FToken);
end;
FToken := NextToken;
end;
end;
{ Scans for the word "General", it may be used like other tokens }
procedure TsNumFormatParser.ScanGeneral;
begin
FStatus := psErrGeneralExpected;
FToken := NextToken;
if not (FToken in ['e', 'E']) then exit;
FToken := NextToken;
if not (FToken in ['n', 'N']) then exit;
FToken := NextToken;
if not (FToken in ['e', 'E']) then exit;
FToken := NextToken;
if not (FToken in ['r', 'R']) then exit;
FToken := NextToken;
if not (FToken in ['a', 'A']) then exit;
FToken := NextToken;
if not (FToken in ['l', 'L']) then exit;
AddElement(nftGeneral);
FStatus := psOK;
end;
{ Scans a floating point format. Procedure is left with the cursor at the last
character of the format. }
procedure TsNumFormatParser.ScanNumber;
var
hasDecSep: Boolean;
isFrac: Boolean;
n, m: Integer;
el: Integer;
savedCurrent: PChar;
thSep: Char;
begin
hasDecSep := false;
isFrac := false;
thSep := ',';
while (FCurrent < FEnd) and (FStatus = psOK) do begin
case FToken of
',': AddElement(nftThSep, ',');
'.': begin
AddElement(nftDecSep, '.');
hasDecSep := true;
end;
'#': begin
ScanAndCount('#', n);
savedCurrent := FCurrent;
if not (hasDecSep or isFrac) and (n = 1) and (FToken = thSep) then
begin
m := 0;
FToken := NextToken;
ScanAndCount('#', n);
case n of
0: begin
ScanAndCount('0', n);
ScanAndCount(thSep, m);
FToken := prevToken;
if n = 3 then
AddElement(nftIntTh, 3, ',')
else
FCurrent := savedCurrent;
end;
1: begin
ScanAndCount('0', n);
ScanAndCount(thSep, m);
FToken := prevToken;
if n = 2 then
AddElement(nftIntTh, 2, ',')
else
FCurrent := savedCurrent;
end;
2: begin
ScanAndCount('0', n);
ScanAndCount(thSep, m);
FToken := prevToken;
if (n = 1) then
AddElement(nftIntTh, 1, ',')
else
FCurrent := savedCurrent;
end;
end;
if m > 0 then
AddElement(nftFactor, m, thSep);
end else
begin
FToken := PrevToken;
if isFrac then
AddElement(nftFracDenomOptDigit, n)
else
if hasDecSep then
AddElement(nftOptDecs, n)
else
AddElement(nftIntOptDigit, n);
end;
end;
'0': begin
ScanAndCount('0', n);
ScanAndCount(thSep, m);
FToken := PrevToken;
if hasDecSep then
AddElement(nftZeroDecs, n)
else
if isFrac then
AddElement(nftFracDenomZeroDigit, n)
else
AddElement(nftIntZeroDigit, n);
if m > 0 then
AddElement(nftFactor, m, thSep);
end;
'1'..'9':
begin
if isFrac then
begin
n := 0;
while (FToken in ['1'..'9','0']) do
begin
n := n*10 + StrToInt(FToken);
FToken := nextToken;
end;
AddElement(nftFracDenom, n);
end else
AddElement(nftText, FToken);
end;
'?': begin
ScanAndCount('?', n);
FToken := PrevToken;
if hasDecSep then
AddElement(nftSpaceDecs, n)
else
if isFrac then
AddElement(nftFracDenomSpaceDigit, n)
else
AddElement(nftIntSpaceDigit, n);
end;
'E', 'e':
begin
AddElement(nftExpChar, FToken);
FToken := NextToken;
if FToken in ['+', '-'] then
AddElement(nftExpSign, FToken);
FToken := NextToken;
if FToken = '0' then begin
ScanAndCount('0', n);
FToken := PrevToken;
AddElement(nftExpDigits, n);
end;
end;
'+', '-':
AddElement(nftSign, FToken);
'%': AddElement(nftPercent, FToken);
'/': begin
isFrac := true;
AddElement(nftFracSymbol, FToken);
// go back and replace correct token for numerator
el := High(FSections[FCurrSection].Elements);
while el > 0 do begin
dec(el);
case FSections[FCurrSection].Elements[el].Token of
nftIntOptDigit:
begin
FSections[FCurrSection].Elements[el].Token := nftFracNumOptDigit;
break;
end;
nftIntSpaceDigit:
begin
FSections[FCurrSection].Elements[el].Token := nftFracNumSpaceDigit;
break;
end;
nftIntZeroDigit:
begin
FSections[FCurrSection].Elements[el].Token := nftFracNumZeroDigit;
break;
end;
end;
end;
end;
'G', 'g':
ScanGeneral;
else
FToken := PrevToken;
Exit;
end;
FToken := NextToken;
end;
end;
{ Scans a text in quotation marks. Tries to interpret the text as a currency
symbol (--> AnalyzeText).
The procedure is entered and left with the cursor at a quotation mark. }
procedure TsNumFormatParser.ScanQuotedText;
var
s: String;
begin
s := '';
FToken := NextToken; // Cursor war at '"'
while (FCurrent < FEnd) and (FStatus = psOK) do begin
if FToken = '"' then begin
if AnalyzeCurrency(s) then
AddElement(nftCurrSymbol, s)
else
AddElement(nftText, s);
exit;
end else begin
s := s + FToken;
FToken := NextToken;
end;
end;
// When the procedure gets here the final quotation mark is missing
FStatus := psErrQuoteExpected;
end;
procedure TsNumFormatParser.SetDecimals(AValue: Byte);
var
i, j, n: Integer;
foundDecs: Boolean;
begin
foundDecs := false;
for j := 0 to High(FSections) do begin
n := Length(FSections[j].Elements);
i := n-1;
while (i > -1) do begin
case FSections[j].Elements[i].Token of
nftDecSep: // this happens, e.g., for "0.E+00"
if (AValue > 0) and not foundDecs then begin
InsertElement(j, i, nftZeroDecs, AValue);
break;
end;
nftIntOptDigit, nftIntZeroDigit, nftIntSpaceDigit, nftIntTh:
// no decimals so far --> add decimal separator and decimals element
if (AValue > 0) then begin
// Don't use "AddElements" because nfCurrency etc have elements after the number.
InsertElement(j, i, nftDecSep, '.');
InsertElement(j, i+1, nftZeroDecs, AValue);
break;
end;
nftZeroDecs, nftOptDecs, nftSpaceDecs:
begin
foundDecs := true;
if AValue > 0 then begin
// decimals are already used, just replace value of decimal places
FSections[j].Elements[i].IntValue := AValue;
FSections[j].Elements[i].Token := nftZeroDecs;
break;
end else begin
// No decimals any more: delete decs and decsep elements
DeleteElement(j, i);
DeleteElement(j, i-1);
break;
end;
end;
end;
dec(i);
end;
end;
end;
end.
Reference in New Issue View Git Blame Copy Permalink