{$APPTYPE CONSOLE}
{$MODE OBJFPC}
{$LONGSTRINGS ON}
uses SysUtils, StrUtils;
// Extracted to exclude stack cluttering
function TryStrToFloatIgnoreThousandSeparator(const S: string;
const FS: TFormatSettings; out Value: ValReal): Boolean;
begin
Result := TryStrToFloat(DelChars(S, FS.ThousandSeparator), Value, FS);
end;
function TryStrToFloatEx(const S: string; const FS: TFormatSettings;
out Value: ValReal): Boolean;
const
CDigits: array of Char = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9');
var
IndexOfSeparator: SizeInt;
IndexOfFirstDigit: SizeInt;
CountOfChars: SizeInt;
iChar: SizeInt;
begin
Result := False;
if Pos(FS.ThousandSeparator, S) = 0 then
Exit(TryStrToFloat(S, Value, FS));
IndexOfSeparator := Pos(FS.DecimalSeparator, S) - 1;
if IndexOfSeparator < 0 then
IndexOfSeparator := S.LastIndexOfAny(['e', 'E']);
if IndexOfSeparator < 0 then
IndexOfSeparator := Length(S);
//No TS allowed after DS or E
if Pos(FS.ThousandSeparator, S, IndexOfSeparator) > 0 then //needs fpc 3.2.2 or higher
Exit;
IndexOfFirstDigit := S.IndexOfAny(CDigits);
if IndexOfFirstDigit < 0 then
Exit;
CountOfChars := 1;
for iChar := IndexOfSeparator downto IndexOfFirstDigit + 1 do
begin
// (N mod 4) = 0 equal (N and 3) = 0, but faster
if ((CountOfChars and 3) = 0) <> (S[iChar] = FS.ThousandSeparator) then
Exit;
Inc(CountOfChars);
end;
Result := TryStrToFloatIgnoreThousandSeparator(S, FS, Value);
end;
procedure Test(const S: string);
var
FS: TFormatSettings;
Value: ValReal;
begin
FS := DefaultFormatSettings;
FS.DecimalSeparator := '#';
FS.ThousandSeparator := '_';
Write(S);
if TryStrToFloatEx(S, FS, Value) then
Writeln(' - OK, value is ', Value:0:3)
else
Writeln(' - Fail');
end;
begin
Writeln('ThousandSeparator = _, DecimalSeparator = #');
Writeln;
Test('12.15');
Test('2___000_000#123');
Test('3_456#123');
Test('4_0_0_0_0_0_0#123');
Test('5_000#123_4');
Test('6#000#123');
Test('_456#123');
Test('7_000e2#123');
Test('8_000#123e2');
Readln;
end.
Recent
