How to convert float or currency to a localized string? - string

In Delphi1, using FloatToStrF or CurrToStrF will automatically use the DecimalSeparator character to represent a decimal mark. Unfortunately DecimalSeparator is declared in SysUtils as Char1,2:
var
DecimalSeparator: Char;
While the LOCALE_SDECIMAL is allowed to be up to three characters:
Character(s) used for the decimal separator, for example, "." in "3.14" or "," in "3,14". The maximum number of characters allowed for this string is four, including a terminating null character.
This causes Delphi to fail to read the decimal separator correctly; falling back to assume a default decimal separator of ".":
DecimalSeparator := GetLocaleChar(DefaultLCID, LOCALE_SDECIMAL, '.');
On my computer, which is quite a character, this cause floating point and currency values to be incorrectly localized with a U+002E (full stop) decimal mark.
i am willing to call the Windows API functions directly, which are designed to convert floating point, or currency, values into a localized string:
GetNumberFormat
GetCurrencyFormat
Except these functions take a string of picture codes, where the only characters allowed are:
Characters "0" through "9" (U+0030..U+0039)
One decimal point (.) if the number is a floating-point value (U+002E)
A minus sign in the first character position if the number is a negative value (U+002D)
What would be a good way1 to convert a floating point, or currency, value to a string that obeys those rules? e.g.
1234567.893332
-1234567
given that the local user's locale (i.e. my computer):
might not use a - to indicate negative (e.g. --)
might not use a . to indicate a decimal point (e.g. ,,)
might not use the latin alphabet 0123456789 to represent digits (e.g. [removed arabic digits that crash SO javascript parser])
A horrible, horrible, hack, which i could use:
function FloatToLocaleIndependantString(const v: Extended): string;
var
oldDecimalSeparator: Char;
begin
oldDecimalSeparator := SysUtils.DecimalSeparator;
SysUtils.DecimalSeparator := '.'; //Windows formatting functions assume single decimal point
try
Result := FloatToStrF(Value, ffFixed,
18, //Precision: "should be 18 or less for values of type Extended"
9 //Scale 0..18. Sure...9 digits before decimal mark, 9 digits after. Why not
);
finally
SysUtils.DecimalSeparator := oldDecimalSeparator;
end;
end;
Additional info on the chain of functions the VCL uses:
FloatToStrF and CurrToStrF calls:
FloatToText calls:
FloatToDecimal
Note
DecimalSeparator: Char, the single character global is deprecated, and replaced with another single character decimal separator
1 in my version of Delphi
2 and in current versions of Delphi

Delphi does provide a procedure called FloatToDecimal that converts floating point (e.g. Extended) and Currency values into a useful structure for further formatting. e.g.:
FloatToDecimal(..., 1234567890.1234, ...);
gives you:
TFloatRec
Digits: array[0..20] of Char = "12345678901234"
Exponent: SmallInt = 10
IsNegative: Boolean = True
Where Exponent gives the number of digits to the left of decimal point.
There are some special cases to be handled:
Exponent is zero
Digits: array[0..20] of Char = "12345678901234"
Exponent: SmallInt = 0
IsNegative: Boolean = True
means there are no digits to the left of the decimal point, e.g. .12345678901234
Exponent is negative
Digits: array[0..20] of Char = "12345678901234"
Exponent: SmallInt = -3
IsNegative: Boolean = True
means you have to place zeros in between the decimal point and the first digit, e.g. .00012345678901234
Exponent is -32768 (NaN, not a number)
Digits: array[0..20] of Char = ""
Exponent: SmallInt = -32768
IsNegative: Boolean = False
means the value is Not a Number, e.g. NAN
Exponent is 32767 (INF, or -INF)
Digits: array[0..20] of Char = ""
Exponent: SmallInt = 32767
IsNegative: Boolean = False
means the value is either positive or negative infinity (depending on the IsNegative value), e.g. -INF
We can use FloatToDecimal as a starting point to create a locale-independent string of "pictures codes".
This string can then be passed to appropriate Windows GetNumberFormat or GetCurrencyFormat functions to perform the actual correct localization.
i wrote my own CurrToDecimalString and FloatToDecimalString which convert numbers into the required locale independent format:
class function TGlobalization.CurrToDecimalString(const Value: Currency): string;
var
digits: string;
s: string;
floatRec: TFloatRec;
begin
FloatToDecimal({var}floatRec, Value, fvCurrency, 0{ignored for currency types}, 9999);
//convert the array of char into an easy to access string
digits := PChar(Addr(floatRec.Digits[0]));
if floatRec.Exponent > 0 then
begin
//Check for positive or negative infinity (exponent = 32767)
if floatRec.Exponent = 32767 then //David Heffernan says that currency can never be infinity. Even though i can't test it, i can at least try to handle it
begin
if floatRec.Negative = False then
Result := 'INF'
else
Result := '-INF';
Exit;
end;
{
digits: 1234567 89
exponent--------^ 7=7 digits on left of decimal mark
}
s := Copy(digits, 1, floatRec.Exponent);
{
for the value 10000:
digits: "1"
exponent: 5
Add enough zero's to digits to pad it out to exponent digits
}
if Length(s) < floatRec.Exponent then
s := s+StringOfChar('0', floatRec.Exponent-Length(s));
if Length(digits) > floatRec.Exponent then
s := s+'.'+Copy(digits, floatRec.Exponent+1, 20);
end
else if floatRec.Exponent < 0 then
begin
//check for NaN (Exponent = -32768)
if floatRec.Exponent = -32768 then //David Heffernan says that currency can never be NotANumber. Even though i can't test it, i can at least try to handle it
begin
Result := 'NAN';
Exit;
end;
{
digits: .000123456789
^---------exponent
}
//Add zero, or more, "0"'s to the left
s := '0.'+StringOfChar('0', -floatRec.Exponent)+digits;
end
else
begin
{
Exponent is zero.
digits: .123456789
^
}
if length(digits) > 0 then
s := '0.'+digits
else
s := '0';
end;
if floatRec.Negative then
s := '-'+s;
Result := s;
end;
Aside from the edge cases of NAN, INF and -INF, i can now pass these strings to Windows:
class function TGlobalization.GetCurrencyFormat(const DecimalString: WideString; const Locale: LCID): WideString;
var
cch: Integer;
ValueStr: WideString;
begin
Locale
LOCALE_INVARIANT
LOCALE_USER_DEFAULT <--- use this one (windows.pas)
LOCALE_SYSTEM_DEFAULT
LOCALE_CUSTOM_DEFAULT (Vista and later)
LOCALE_CUSTOM_UI_DEFAULT (Vista and later)
LOCALE_CUSTOM_UNSPECIFIED (Vista and later)
}
cch := Windows.GetCurrencyFormatW(Locale, 0, PWideChar(DecimalString), nil, nil, 0);
if cch = 0 then
RaiseLastWin32Error;
SetLength(ValueStr, cch);
cch := Windows.GetCurrencyFormatW(Locale, 0, PWideChar(DecimalString), nil, PWideChar(ValueStr), Length(ValueStr));
if (cch = 0) then
RaiseLastWin32Error;
SetLength(ValueStr, cch-1); //they include the null terminator /facepalm
Result := ValueStr;
end;
The FloatToDecimalString and GetNumberFormat implementations are left as an exercise for the reader (since i actually haven't written the float one yet, just the currency - i don't know how i'm going to handle exponential notation).
And Bob's yer uncle; properly localized floats and currencies under Delphi.
i already went through the work of properly localizing Integers, Dates, Times, and Datetimes.
Note: Any code is released into the public domain. No attribution required.

Ok, this may not be what you want, but it works with D2007 and up.
Thread safe and all.
uses Windows,SysUtils;
var
myGlobalFormatSettings : TFormatSettings;
// Initialize special format settings record
GetLocaleFormatSettings( 0,myGlobalFormatSettings);
myGlobalFormatSettings.DecimalSeparator := '.';
function FloatToLocaleIndependantString(const value: Extended): string;
begin
Result := FloatToStrF(Value, ffFixed,
18, //Precision: "should be 18 or less for values of type Extended"
9, //Scale 0..18. Sure...9 digits before decimal mark, 9 digits after. Why not
myGlobalFormatSettings
);
end;

Related

Implementation of Integer'Value("X") in Ada

I'm going to create a subprogram with two parameters; one string and one integer. The subrprogram is going to compare these two and see if they are the same.
For instance:
Type a string containing exactly 5 characters, and an Integer: 12345 123
-- User types in bold
They are not the same!
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure Test2 is
function String_Integer_Check(
S : in String;
I : in Integer) return Boolean is
begin
if Integer'Value(S) = I then
return True;
else
return False;
end if;
end String_Integer_Check;
S : String(1..5);
I : Integer;
begin
Put("Type in a string containing exactly 5 characters, and an integer: ");
Get(S);
Get(I);
Put("They are ");
if String_Integer_Check(S, I) = False then
Put("not ");
end if;
Put("the same.");
end Test2;
My program works, assuming that the user types in a string of 5 characters. If the user doesn't my program won't work. How do I fix this?
If I type 123 1234 (String is 3 characters and the Integer is 4 numbers), I will get this error:
They are
raised CONTRAINT_ERROR : bad input for 'Value: "123 1"
Ensure the two inputs are on different lines. The I/O problems you are seeing result from mixing string I/O and integer I/O on the same input line. This is a problem when the string portion of the input contains more or less than 5 characters.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure value_compare is
str_num : String (1 .. 80);
length : Natural;
num : Integer;
begin
Put ("Enter a 5 digit number: ");
Get_Line (Item => str_num, Last => length);
if length = 5 then
Put ("Enter a number: ");
Get (num);
if num = Integer'Value (str_num(1..Length)) then
Put_Line ("The two values are equal.");
else
Put_Line ("The two values are not equal.");
end if;
else
Put_Line
("The input value " & str_num (1 .. length) &
" does not contain 5 exactly characters.");
end if;
end value_compare;

Integer to String goes wrong in Synthesis (Width Mismatch)

I am trying to convert a integer to string (using integer'image(val)) and either pad or limit it to a specific length. I have made this function which does the job just fine when I use a report statement and simulate.
function integer2string_pad(val: integer; stringSize: integer) return string is
variable imageString: string(1 to integer'image(val)'length);
variable returnString: string(1 to stringSize);
begin
imageString := integer'image(val);
-- Are we smaller than the desired size?
if integer'image(val)'length < stringSize then
-- Pad the string if we are
returnString := integer'image(val) & (1 to stringSize-integer'image(val)'length => ' ');
-- Are we to big for the desired size
elsif integer'image(val)'length > stringSize then
-- Only use the top most string bits and append a "." to the end signifing that there is more
returnString := imageString(1 to stringSize-1) & ".";
-- Otherwise we are just the right size
else
returnString := integer'image(val);
end if;
return returnString;
end function;
Here is some sample input, output of that function (underscore = space because SO inline code truncates extra space):
integer2string_pad(12, 6) : 12____
integer2string_pad(123456, 6) : 123456
integer2string_pad(1234567890, 6) : 12345.
integer2string_pad(0, 6) : 0_____
integer2string_pad(-123, 6) : -123__
integer2string_pad(-1, 6) : -1____
integer2string_pad(-123456, 6) : -1234.
But when I synthesize, I get width mismatch errors on all 4 lines where I assign values to pongScoreLeft or pongScoreRight. It also says they have a constant value of 0 and get trimmed out.
Width mismatch. <pongScoreLeft> has a width of 48 bits but assigned
expression is 6-bit wide.
Width mismatch. <pongScoreRight> has a width
of 48 bits but assigned expression is 6-bit wide.
Width mismatch. <pongScoreLeft> has a width of 48 bits but assigned expression is 6-bit wide.
Width mismatch. <pongScoreRight> has a width of 48 bits but assigned expression is 6-bit wide.
VHDL that produces those width mismatch errors:
type type_score is
record
left : integer range 0 to 255;
right : integer range 0 to 255;
end record;
constant init_type_score: type_score := (left => 0, right => 0);
signal pongScore: type_score := init_type_score;
signal pongScoreLeft: string(1 to 6) := (others => NUL);
signal pongScoreRight: string(1 to 6) := (others => NUL);
...
scoreToString: process(clk)
begin
if rising_edge(clk) then
if reset = '1' then
pongScoreLeft <= (others => NUL);
pongScoreRight <= (others => NUL);
else
pongScoreLeft <= integer2string_pad(pongScore.left, 6);
pongScoreRight <= integer2string_pad(pongScore.right, 6);
--report "|" & integer2string_pad(pongScore.left, 6) & "|";
end if;
end if;
end process;
What is wrong with my integer2string_pad function? What goes wrong in synthesis?
I would not expect 'image or 'value to be supported for synthesis - other than in asserts that run at elaboration time. They would involve a lot of processing.
Whenever I have converted integers to ASCII I have processed a character at a time, using character'val and character'pos, which are synthesisable, because they involve no processing; they just convert a character to/from its underlying binary representation.
EDIT:
Think how you would implement 'image! It involves multiple divisions by 10 : that's a LOT of hardware if you unroll it into a single delta cycle (as required by the semantics of an unclocked function call)
Processing a digit per (several) clock cycle(s) you can reduce that to a single division, or successive subtraction, or excess-6 addition, or however you want according to your hardware resources and time budget.
It really doesn't make sense for the synthesis tool to make these decisions on your behalf. So - while I concede it's theoretically possible, I would be surprised to see a synth tool that did it correctly. (OTOH it's such an unlikely scenario I'd not be surprised to see bugs in synth tool's error reporting should you try it)

How do I count characters in a string, excluding certain types?

I need to determine the total number of characters in a textbox and display the value in a label, but all whitespace need to be excluded.
Here is the code:
var
sLength : string;
i : integer;
begin
sLength := edtTheText.Text;
slength:= ' ';
i := length(sLength);
//display the length of the string
lblLength.Caption := 'The string is ' + IntToStr(i) + ' characters long';
You can count the non-white space characters like this:
uses
Character;
function NonWhiteSpaceCharacterCount(const str: string): Integer;
var
c: Char;
begin
Result := 0;
for c in str do
if not Character.IsWhiteSpace(c) then
inc(Result);
end;
This uses Character.IsWhiteSpace to determine whether or not a character is whitespace. IsWhiteSpace returns True if and only if the character is classified as being whitespace, according to the Unicode specification. So, tab characters count as whitespace.
If you are using an Ansi version of Delphi you can also use a Lookup Table with something like
NotBlanks: Array[0..255] Of Boolean
A Bool in the array is set if the matching character is not a blank. Then In the loop you simply increment your counter
Count := 0;
For i := 1 To Length(MyStringToParse) Do
Inc(Count, Byte(NotBlanks[ Ord(MyStringToParse[i]])) );
In the same fashion you can use a set:
For i := 1 To Length(MyStringToParse) Do
If Not (MyStringToParse[i] In [#1,#2{define the blanks in this enum}]) Then
Inc(Count).
Actually you have many ways to solve this.

How to detect if a character from a string is upper or lower case?

I'm expanding a class of mine for storing generic size strings to allow more flexible values for user input. For example, my prior version of this class was strict and allowed only the format of 2x3 or 9x12. But now I'm making it so it can support values such as 2 x 3 or 9 X 12 and automatically maintain the original user's formatting if the values get changed.
The real question I'm trying to figure out is just how to detect if one character from a string is either upper or lower case? Because I have to detect case sensitivity. If the deliminator is 'x' (lowercase) and the user inputs 'X' (uppercase) inside the value, and case sensitivity is turned off, I need to be able to find the opposite-case as well.
I mean, the Pos() function is case sensitive...
Delphi 7 has UpperCase() and LowerCase() functions for strings. There's also UpCase() for characters.
If I want to search for a substring within another string case insensitively, I do this:
if Pos('needle', LowerCase(hayStack)) > 0 then
You simply use lower case string literals (or constants) and apply the lowercase function on the string before the search. If you'll be doing a lot of searches, it makes sense to convert just once into a temp variable.
Here's your case:
a := '2 x 3'; // Lowercase x
b := '9 X 12'; // Upper case X
x := Pos('x', LowerCase(a)); // x = 3
x := Pos('x', LowerCase(b)); // x = 3
To see if a character is upper or lower, simply compare it against the UpCase version of it:
a := 'A';
b := 'b';
upper := a = UpCase(a); // True
upper := b = UpCase(b); // False
try using these functions (which are part of the Character unit)
Character.TCharacter.IsUpper
Character.TCharacter.IsLower
IsLower
IsUpper
UPDATE
For ansi versions of delphi you can use the GetStringTypeEx functions to fill a list with each ansi character type information. and thne compare the result of each element against the $0001(Upper Case) or $0002(Lower Case) values.
uses
Windows,
SysUtils;
Var
LAnsiChars: array [AnsiChar] of Word;
procedure FillCharList;
var
lpSrcStr: AnsiChar;
lpCharType: Word;
begin
for lpSrcStr := Low(AnsiChar) to High(AnsiChar) do
begin
lpCharType := 0;
GetStringTypeExA(LOCALE_USER_DEFAULT, CT_CTYPE1, #lpSrcStr, SizeOf(lpSrcStr), lpCharType);
LAnsiChars[lpSrcStr] := lpCharType;
end;
end;
function CharIsLower(const C: AnsiChar): Boolean;
const
C1_LOWER = $0002;
begin
Result := (LAnsiChars[C] and C1_LOWER) <> 0;
end;
function CharIsUpper(const C: AnsiChar): Boolean;
const
C1_UPPER = $0001;
begin
Result := (LAnsiChars[C] and C1_UPPER) <> 0;
end;
begin
try
FillCharList;
Writeln(CharIsUpper('a'));
Writeln(CharIsUpper('A'));
Writeln(CharIsLower('a'));
Writeln(CharIsLower('A'));
except
on E:Exception do
Writeln(E.Classname, ': ', E.Message);
end;
Readln;
end.
if myChar in ['A'..'Z'] then
begin
// uppercase
end
else
if myChar in ['a'..'z'] then
begin
// lowercase
end
else
begin
// not an alpha char
end;
..or D2009 on..
if charInSet(myChar,['A'..'Z']) then
begin
// uppercase
end
else
if charInSet(myChar,['a'..'z']) then
begin
// lowercase
end
else
begin
// not an alpha char
end;
The JCL has routines for this in the JclStrings unit, eg CharIsUpper and CharIsLower. SHould work in Delphi 7.
AnsiPos() is not case-sensitive. You can also force upper or lower case, irrespective of what the user enters using UpperCase() and LowerCase().
Just throwing this out there since you may find it far more simple than the other (very good) answers.

How to find a position of a substring within a string with fuzzy match

I have come across a problem of matching a string in an OCR recognized text and find the position of it considering there can be arbitrary tolerance of wrong, missing or extra characters. The result should be a best match position, possibly (not necessarily) with length of matching substring.
For example:
String: 9912, 1.What is your name?
Substring: 1. What is your name?
Tolerance: 1
Result: match on character 7
String: Where is our caat if any?
Substring: your cat
Tolerance: 2
Result: match on character 10
String: Tolerance is t0o h1gh.
Substring: Tolerance is too high;
Tolerance: 1
Result: no match
I have tried to adapt Levenstein algorithm, but it doesn't work properly for substrings and doesn't return position.
Algorithm in Delphi would be preferred, yet any implementation or pseudo logic would do.
Here's a recursive implementation that works, but might not be fast enough. The worst case scenario is when a match can't be found, and all but the last char in "What" gets matched at every index in Where. In that case the algorithm will make Length(What)-1 + Tolerance comparasions for each char in Where, plus one recursive call per Tolerance. Since both Tolerance and the length of What are constnats, I'd say the algorithm is O(n). It's performance will degrade linearly with the length of both "What" and "Where".
function BrouteFindFirst(What, Where:string; Tolerance:Integer; out AtIndex, OfLength:Integer):Boolean;
var i:Integer;
aLen:Integer;
WhatLen, WhereLen:Integer;
function BrouteCompare(wherePos, whatPos, Tolerance:Integer; out Len:Integer):Boolean;
var aLen:Integer;
aRecursiveLen:Integer;
begin
// Skip perfect match characters
aLen := 0;
while (whatPos <= WhatLen) and (wherePos <= WhereLen) and (What[whatPos] = Where[wherePos]) do
begin
Inc(aLen);
Inc(wherePos);
Inc(whatPos);
end;
// Did we find a match?
if (whatPos > WhatLen) then
begin
Result := True;
Len := aLen;
end
else if Tolerance = 0 then
Result := False // No match and no more "wild cards"
else
begin
// We'll make an recursive call to BrouteCompare, allowing for some tolerance in the string
// matching algorithm.
Dec(Tolerance); // use up one "wildcard"
Inc(whatPos); // consider the current char matched
if BrouteCompare(wherePos, whatPos, Tolerance, aRecursiveLen) then
begin
Len := aLen + aRecursiveLen;
Result := True;
end
else if BrouteCompare(wherePos + 1, whatPos, Tolerance, aRecursiveLen) then
begin
Len := aLen + aRecursiveLen;
Result := True;
end
else
Result := False; // no luck!
end;
end;
begin
WhatLen := Length(What);
WhereLen := Length(Where);
for i:=1 to Length(Where) do
begin
if BrouteCompare(i, 1, Tolerance, aLen) then
begin
AtIndex := i;
OfLength := aLen;
Result := True;
Exit;
end;
end;
// No match found!
Result := False;
end;
I've used the following code to test the function:
procedure TForm18.Button1Click(Sender: TObject);
var AtIndex, OfLength:Integer;
begin
if BrouteFindFirst(Edit2.Text, Edit1.Text, ComboBox1.ItemIndex, AtIndex, OfLength) then
Label3.Caption := 'Found #' + IntToStr(AtIndex) + ', of length ' + IntToStr(OfLength)
else
Label3.Caption := 'Not found';
end;
For case:
String: Where is our caat if any?
Substring: your cat
Tolerance: 2
Result: match on character 10
it shows a match on character 9, of length 6. For the other two examples it gives the expected result.
Here is a complete sample of fuzzy match (approximate search), and you can use/change the algorithm as you wish!
https://github.com/alidehban/FuzzyMatch

Resources