Function to increment filename - delphi

I'm trying to make a function that can increment a filename.
If last char of the string is a number then increment it.
If last char is a letter then add _1 or _2 or _3(increment this also).
I have to be sure the filename is unique but i cannot use datetime inside filename because all the filenames must be <32 chars without extension.
EX: Apple_99.txt =>Apple_100
Ex: Apple_173 => Apple_174
EX: This_is_my_first_text.txt => This_is_my_first_text_1.txt
Ex: This_is_my_first_text_9.txt => This_is_my_first_text_10.txt
I need to use this in order to rename a file an then upload it to a ftp server.
I've found a function that can do something like this but it only works if the filename contains only uppercase.How can I modify this function in order to access lowercase an uppercase string?
Here is the function:
function IncStr(Str: String; Amount: Integer; Index: Integer = -1): String;
const
MIN_VAL = 65; // 'A'
MAX_VAL = 90; // 'Z'
var
Digit, ToAdd, ToCarry: Integer;
begin
if (Index = 0) and (Amount > 0) then
begin
Result := Char(MIN_VAL + Amount - 1) + Str;
Exit;
end;
if Index = -1 then Index := Length(Str);
ToCarry := 0;
Digit := Ord(Str[Index]);
while not (Digit in [MIN_VAL..MAX_VAL]) do
begin
Dec(Index);
Digit := Ord(Str[Index]);
end;
ToAdd := Digit + Amount;
while (ToAdd > MAX_VAL) do
begin
Dec(ToAdd, 26);
Inc(ToCarry);
end;
Result := Str;
Result[Index] := Char(ToAdd);
if (ToCarry > 0) then
Result := IncStr(Result, ToCarry, Index - 1);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
S: String; // holds string to increment
C: Integer; // amount to increment by
begin
// make sure that Edit1 starts with a valid character
// i.e. 'A' to 'Z'
S := Edit1.Text;
C := StrtoIntDef(Edit2.Text, 0);
// test it, place result in Edit3
Edit3.Text := IncStr(S, C);
{
Example data:
Edit1 := AAZ
Edit2 := 2
= Edit3 := ABB
Edit1 := BZY
Edit2 := 3
= Edit3 := CAB
Edit1 := ZZZ
Edit2 := 1
= Edit3 := AAAA
Edit1 := AA-AC
Edit2 := 3
= Edit3 := AA-AF
Edit1 := AA/Z
Edit2 := 5
= Edit3 := AB/E
... etc
Here's one to try too :-)
Edit1 := ZZZ
Edit2 := 264172
}
end;
Thank you!

Like so many programming problems, the key is to break the problem down into small pieces. First of all, let's write a function to decode the original file name into its constituent parts:
procedure DecodeFileName(const Input: string; out Stem, Ext: string; out Number: Integer);
var
P: Integer;
begin
Ext := TPath.GetExtension(Input);
Stem := TPath.GetFileNameWithoutExtension(Input);
Number := 0;
P := Stem.LastIndexOf('_');
if P = -1 then begin
exit;
end;
if TryStrToInt(Stem.Substring(P+1), Number) then begin
Stem := Stem.Substring(0, P);
end;
end;
The following demonstrates how this works:
DecodeFileName('test.txt', Stem, Ext, Number);
Writeln(Stem, ', ', Number, ', ', Ext);
DecodeFileName('test_dd.txt', Stem, Ext, Number);
Writeln(Stem, ', ', Number, ', ', Ext);
DecodeFileName('test_23.txt', Stem, Ext, Number);
Writeln(Stem, ', ', Number, ', ', Ext);
The output is:
test, 0, .txt
test_dd, 0, .txt
test, 23, .txt
So now you can make a new filename like this:
function IncrementedFileName(const FileName: string): string;
var
Stem, Ext: string;
Number: Integer;
begin
DecodeFileName(FileName, Stem, Ext, Number);
Result := Format('%s_%d%s', [Stem, Number+1, Ext]);
end;
And then we can see how that performs:
Writeln(IncrementedFileName('test.txt'));
Writeln(IncrementedFileName('test_dd.txt'));
Writeln(IncrementedFileName('test_23.txt'));
Writeln(IncrementedFileName('test_28'));
The output is:
test_1.txt
test_dd_1.txt
test_24.txt
test_29
If you don't have access to the string helper methods then you can code it like this:
procedure DecodeFileName(const Input: string; out Stem, Ext: string; out Number: Integer);
var
P: Integer;
begin
Ext := TPath.GetExtension(Input);
Stem := TPath.GetFileNameWithoutExtension(Input);
Number := 0;
P := LastDelimiter('_', Stem);
if P = 0 then begin
exit;
end;
if TryStrToInt(Copy(Stem, P+1, MaxInt), Number) then begin
Stem := Copy(Stem, 1, P-1);
end;
end;
I have not executed this final function, so do not be surprised if it has errors.

Related

delete all words with more than 4 letters in a string (Pascal)?

I was assigned a task for university where I have to write a program which deletes all words with more than 4 letters. I really have no clue at all. I would be very thankful for any kind of help.
VAR
UserString: string; //должна быть строка на 40 символов и точку в конце
i, n: byte;
BEGIN
Writeln('Enter the string:');
Readln(UserString);
i:=0;
n:=1;
repeat //MAIN LOOP:
inc(i);
if (UserString[i] = ' ') or (UserString[i] = '.') then
begin
if (i-n<3)then
begin
delete(UserString, n, i-n+1);
i:=n-1;
end;
n:=i+1
end
until (UserString[i] = '.') or (i>length(UserString));
Writeln('Result String: ', UserString);
END.
I tried this. and its working on onlinegdb but not on Delphi... and I don't know why...
You should break up the logic into smaller utility functions for each task you need (finding a word, getting the word's length, deleting the word and any subsequent whitespace, etc). It will make the code easier to read and maintain.
For example:
function FindNextWordStart(const S: string; var Index: Integer): Boolean;
var
Len: Integer;
begin
Len := Length(S);
while (Index <= Len) and (Ord(S[Index]) <= 32) do Inc(Index);
Result := (Index <= Len);
end;
function GetWordLength(const S: string; Index: Integer): Integer;
var
StartIdx, Len: Integer;
begin
Len := Length(S);
StartIdx := Index;
while (Index <= Len) and (Ord(S[Index]) > 32) do Inc(Index);
Result := (Index - StartIdx);
end;
procedure DeleteWord(var S: String; Index, WordLen: Integer);
var
StartIdx, Len: Integer;
begin
Len := Length(S);
StartIdx := Index;
Inc(Index, WordLen);
while (Index <= Len) and (Ord(S[Index]) <= 32) do Inc(Index);
Delete(S, StartIdx, Index - StartIdx);
end;
var
UserString: string;
StartIdx, WordLen: Integer;
begin
Writeln('Enter the string:');
Readln(UserString);
StartIdx := 1;
while FindNextWordStart(UserString, StartIdx) do
begin
WordLen := GetWordLength(UserString, StartIdx);
if WordLen > 4 then
DeleteWord(UserString, StartIdx, WordLen)
else
Inc(StartIdx, WordLen);
end;
Writeln('Result String: ', UserString);
end.
Online Demo
I guess you can solve your task with TStringlist class:
uses Classes;
......
var AStrLst : TStringlist ;
i : Integer ,
begin
AStrLst := TStringlist.Create ;
try
// use this char for separation of words
AStrLst.Delimiter :=' ';
AStrLst.DelimitedText := ' here comes my sample string ';
for I := AStrLst.Count-1 to 0 do
begin
// delete item from list if ...
if length( trim(AStrLst[i])) <= 4 then AStrLst.Delete(i);
end;
finally
// get the complete
writeln ( AStrLst.Text ) ;
AStrLst.Free;
end;
end;
I did not test this code - but hope it helps - to get this code running, your home work

How to effectively check if a string contains one of a few sub strings?

How can I effectively check if a string contains one of a few sub strings?
Suppose I have a string:
`Hi there, <B>my</B> name is Joe <DIV>.</DIV> Hello world. `
How can I check if the string contains either <B> OR <DIV> OR ?
I could do a simple:
Result := (Pos('<B>', S) > 0) or
(Pos('<DIV>', S) > 0) or
(Pos(' ', S) > 0);
But this seems to be very inefficient since it make N (at worst) passes and my strings are considerably large.
Slightly better version:
function StringContainsAny(const S: string; const AnyOf: array of string): Boolean;
var
CurrChr, C: PChar;
i, j, Ln: Integer;
begin
for i := 1 to Length(S) do
begin
CurrChr := #S[i];
for j := 0 to High(AnyOf) do
begin
C := #AnyOf[j][1]; // assume that no empty strings
if C^ <> CurrChr^ then
Continue;
Ln := Length(AnyOf[j]);
if (Length(S) + 1 - i) < Ln then // check bounds
Continue;
if CompareMem(C, CurrChr, Ln * SizeOf(C^)) then
Exit(True);
end;
end;
Exit(False);
end;
You can also build some table of stop-symbols and improve speed. It's kinda complex topic, so I can just suggest you to read, for example, book Bill Smyth "Computing Patterns in Strings".
Here is my solution, thanks to David Heffernan comment:
function StringContainsAny(const S: string; const AnyOf: array of string): Boolean;
var
CurrChr, C: PChar;
I, L, H: Integer;
begin
Result := False;
CurrChr := PChar(S);
while CurrChr^ <> #0 do
begin
H := High(AnyOf);
for I := 0 to H do
begin
L := 0;
C := PChar(AnyOf[I]);
while C^ <> #0 do
begin
if C^ = CurrChr^ then
Inc(L)
else
Break;
Inc(C);
Inc(CurrChr);
if CurrChr^ = #0 then // end of S string
begin
Result := (C^ = #0);
if Result or (not Result and (I = H)) then // match or last AnyOf
Exit;
end;
end;
if C^ = #0 then // match
begin
Result := True;
Exit;
end
else
Dec(CurrChr, L);
end;
Inc(CurrChr);
end;
end;
I'm not sure it is perfect.
EDIT:
What can I say? You know what they say about assumptions...
after actually testing, it seems like using Pos():
function StringContainsAny(const S: string; const AnyOf: array of string): Boolean;
var
I: Integer;
begin
for I := 0 to High(AnyOf) do
begin
if Pos(AnyOf[I], S) <> 0 then
begin
Result := True;
Exit;
end;
end;
Result := False;
end;
Is faster than my solution and #Green_Wizard solution! they did a good job with the Pos function!

how to get two different file with this procedure in deplhi

i want to get value from two file .txt, one file contain different dimension matrix with other
i have try this code:
procedure TfrmJST.ParseDelimited(const S1: TStrings; const Value: String; const Delimiter: String);
var
dx,cx: integer;
ns,ms: String;
txt: string;
delta,teta: integer;
procedure TfrmJST.ParseDelimited(const S1: TStrings; const Value: String; const Delimiter: String);
var
dx,cx: integer;
ns,ms: String;
txt: string;
delta,teta: integer;
begin
Col := 1;
Delta := Length(Delimiter);
Txt := Value+Delimiter;;
begin
while Length(Txt) > 1 do
begin
Dx := Pos(Delimiter, Txt);
Ns := Trim(Copy(Txt, 1, Dx-1));
// S1.Add('#'+Ns+'*'); //only needed for testing
if Ns <> '' then
begin
Matrix[Row,Col] := StrToFloat(Ns); //for first matrix
Inc(Col);
end;
Txt := Copy(Txt, Dx+Delta, MaxInt);
end;
end;
Col := 1;
teta := Length(delimiter);
txt := value+delimiter;
begin
while Length(txt) > 1 do
begin
cx := Pos(delimiter, txt);
ms := Copy(txt, 1, cx-1);
if ms <> '' then
begin
ref[Row,Col] := StrToFloat(ms); ///for 2nd matrix
Inc(Col);
end;
txt := Copy(txt, cx+teta, MaxInt);
end;
end;
end;
and this is initialize of matrix:
private
{ Private declarations }
Row, Col: integer;
Matrix: array[1..140,1..141] of double;
Ref: array[1..2,1..140] of double ;
this is the implementation:
begin
Temp := TStringList.Create;
MemoSL:= TStringList.Create ;
Temp.LoadFromFile('trainer.txt');
Row := 1;
for I := 0 to Temp.Count-1 do
begin
ParseDelimited(MemoSL, Trim(Temp.Strings[I]), ' ');
Inc(Row); //stackoverflow error in this line
end;
Temp.Free;
//parsing second matrix
TempList := TStringList.Create;
Templist.LoadFromFile('refbaru.txt');
row := 1;
for J := 0 to Templist.Count-1 do
begin
T := Templist[J];
ParseDelimited(Memo1.Lines, T, ' ');
Inc(row);
end;
Templist.Free;
i tried that code but give me error,
the error was stackoverflow error in line 'inc(row)' that process first matrix.
and while i gave comment out at the second function that process 2nd matrix, Temp[i] only returns 2 rows of matrix[140x141]. does it mean the code can't process two different file? and why it only return two rows of the matrix?
anyone can help me?
while Length(Txt) > 1 do
begin
Dx := Pos(Delimiter, Txt);
Ns := Trim(Copy(Txt, 1, Dx-1));
// S1.Add('#'+Ns+'*'); //only needed for testing
if Ns <> '' then
begin
Matrix[Row,Col] := StrToFloat(Ns); //for first matrix
Inc(Col);
end;
Txt := Copy(Txt, Dx+Delta, MaxInt);
end;
Looking at this piece of code I see the posibility of an endless loop: what happens if there is no Delimiter found? It will keep running and forever increase your 'col' value. Make sure to have a condition to stop your while loop if no delimeter is found.
It is pointless to look for a specific stack overflow error when many ordinary errors already exist.
If your code is clean programmed and it is still stack overflow, then of course, is time to look deeper into the code.
But first ! As long as you can see obvious errors, you should remove them.
1.) "Row" used in the same procedure on a 140 dimension array and on a only 2 dimension array.
How can that work ?
Matrix: array[1..140,1..141] of double;
Ref: array[1..2,1..140] of double ;
File 'trainer.txt' 140 Lines
File 'refbaru.txt' 2 Lines.
for I := 0 to Temp.Count-1 do // 140 lines
// ParseDelimited() will only run properly if Row < 3
// remember -> Ref: array[1..2,1..140])
// if Row > 2 , with Ref[Row,Col] := , 137 times data is overwritten.
procedure ParseDelimited(MemoSL, Trim(Temp.Strings[I]), ' ');
....
Matrix[Row,Col] := StrToFloat(Ns);
....
Ref[Row,Col] := StrToFloat(ms);
....
end;
Inc(Row);
end;
2.) If you run the second loop with refbaru.txt and the two arrays are present together in the procedure ParseDelimited(), then you overwrite 2 values of array Matrix
recommendation
make sure: Loop through trainer.txt, writes values only to the Matrix array.
make sure: Loop through refbaru.txt, writes values only to the Ref array.
Your code could look something like:
[...]
filetoload: String;
[...]
procedure TfrmJST.ParseDelimited(S1: TStrings; Value: String; const Delimiter: String);
var
f:double;
[...]
Col := 1;
txt := Value+Delimiter;
[...]
if filetoload='trainer.txt' then begin
Delta := Length(Delimiter);
while Length(txt) > 1 do
begin
Dx := Pos(Delimiter, txt);
Ns := Trim(Copy(txt, 1, Dx-1));
if Ns <> '' then
begin
if TryStrToFloat(Ns,f) then Matrix[Row,Col]:=f;
Inc(Col);
if Col > MatrixColMax then break;
txt := Copy(txt, Dx+Delta, MaxInt);
end else txt:='';
end;
end;
if filetoload='refbaru.txt' then begin
teta := Length(delimiter);
while Length(txt) > 1 do
begin
cx := Pos(delimiter, txt);
ms := Copy(txt, 1, cx-1);
if ms <> '' then
begin
if TryStrToFloat(ms,f) then Ref[Row,Col]:=f;
Inc(Col);
if Col > RefColMax then break;
txt := Copy(txt, cx+teta, MaxInt);
end else txt:='';
end;
end;
begin
[...]
filetoload:='trainer.txt';
Temp := TStringList.Create;
Temp.LoadFromFile(filetoload);
if Temp.Count > MatrixRowMax then LinesToLoad:=MatrixRowMax-1 else
LinesToLoad:=Temp.Count-1;
for I := 0 to LinesToLoad do
[...]
ParseDelimited(MemoSL, Trim(Temp.Strings[I]), ' ');
[...]
end;
filetoload:='refbaru.txt';
TempList := TStringList.Create;
TempList.LoadFromFile(filetoload);
if TempList.Count > RefRowMax then LinesToLoad:=RefRowMax-1 else
LinesToLoad:=TempList.Count-1;
for J := 0 to LinesToLoad do
[...]
ParseDelimited(Memo1.Lines, T, ' ');
[...]
end;
end;
You should also compare the linesize of the file with the size of the arrays
RefRowMax: integer;
RefColMax: integer;
MatrixRowMax: integer;
MatrixColMax: integer;
LinesToLoad: integer;
....
RefRowMax:=2;
RefColMax:=140;
MatrixRowMax:=140;
MatrixColMax:=141;
....
procedure ParseDelimited()
if filetoload='trainer.txt' then begin
[...]
Inc(Col)
if Col > MatrixColMax then break;
end;
if filetoload='refbaru.txt' then begin
[...]
Inc(Col)
if Col > RefColMax then break;
end;
You should also look for a valid value of Ns , StrToFloat(Ns) before you write to the arrays in ParseDelimited()
function TryStrToFloat(const S: string; out Value: Double): Boolean;
or
Val();
var
f:double;
....
begin
....
if TryStrToFloat(Ns,f) then Matrix[Row,Col]:=f;
....
The OP overwritting many of used data.
And when he has enough data overwritten, he gets a stack overflow error.

DELPHI STRING: Pull a last name from a full name

I am trying to manipulate a string and pull only certain data from it. I need to do this on a record pulled from a database that gives me the full name of a person. I need to pull only the last name from the string and store it as a variable. Is there a way that I can do this?
Example: SQL query pulls the full field "Mary Ellen Jones" I need to extract only the Jones from the string so I can store it in a variable for further processing.
I thought maybe AnsiRightStr would work but the problem is needing to give it a set integer to pull from the right. Maybe a way to count the characters after the final space allowing me to use AnsiRightStr(string,int) for this? Any help at all is appreciated.
Additional thought: Would replacing the spaces with a delimiter say :: and then parsing that data into a Stringlist followed by allowing me to pull the last index of the string list be possible?
Several valid options have been presented so far. None of them address the situation if say the name is Something like "John St. James, Jr." Is this impossible?
you can use the LastDelimiter function to get the last space position and then with the copy function extract the substring.
uses
SysUtils;
var
Name : string;
p : Integer;
ShortName : string;
begin
Name:='Mary Ellen Jones';
//You can call trim to avoid problems with ending spaces in this case is not necesary, just is a test
//Name:=Trim(Name);
//get the last space position
p:=LastDelimiter(' ',Name);
//get the name
ShortName:=Copy(Name,p+1,length(Name)-p);
end;
or using a function
function GetLast(const Name:string) : string;
var
p : Integer;
begin
Result:=Trim(Name);
p:=LastDelimiter(' ',Result);
Result:=Copy(Result,p+1,length(Result)-p);
end;
function GetLastWord(const Str: string): string;
var
p: integer;
i: Integer;
const
SPACE = #$20;
begin
p := 1;
for i := length(Str) downto 1 do
if Str[i] = SPACE then
begin
p := i + 1;
break;
end;
result := Copy(Str, p, MaxInt);
end;
This will fail if the string ends with (an accidental) space, as 'Andreas Rejbrand '. This more robust version will handle this case too:
function GetLastWord(const Str: string): string;
var
p: integer;
i: Integer;
FoundNonSpace: boolean;
const
SPACE = #$20;
begin
p := 1;
FoundNonSpace := false;
for i := length(Str) downto 1 do
if (Str[i] = SPACE) and FoundNonSpace then
begin
p := i + 1;
break
end
else if Str[i] <> SPACE then
FoundNonSpace := true;
result := TrimRight(Copy(Str, p, MaxInt));
end;
What if the last name is say "St. James" any way to account for that?
Here's my approach.
Make a list of lastname-markers
Search that list in order of preference
As soon as a match is found, mark that as the start of last name
Return substring starting from that pos.
var
LastNameMarkers: TStringList = nil;
SuffixFix: TStringList = nil;
procedure InitLists;
begin
LastNameMarkers:= TStringList.Create;
//LastNameMarkers.LoadFromFile('c:\markers.txt');
LastNameMarkers.Add(' St.');
LastnameMarkers.Add(' Mc');
LastNameMarkers.Add(' '); //Marker of last resort.
SuffixFix:= TStringList.Create;
SuffixFix.Add(' Jr.');
SuffixFix.Add(' Sr.');
end;
function GetLastName(FullName: string): string;
var
i: integer;
start: integer;
found: boolean;
ReplaceWith: string;
begin
if LastNameMarkers = nil then InitLists;
//Fix suffixes
i:= 0;
found:= false;
while (i < SuffixFix.Count) and not found do begin
start:= pos(lower(LastNameMarkers[i]),lower(Fullname));
found:= Start > 0;
Inc(i);
end; {while}
if Found then begin
Dec(i);
ReplaceWith:= StringReplace(Suffix[i], ' ', '_',[]);
FullName:= StringReplace(FullName, SuffixFix[i], ReplaceWith,[]);
end; {if}
//Look for lastnames
i:= 0;
found:= false;
while (i < LastNameMarkers.Count) and not found do begin
start:= pos(LastNameMarkers[i],Fullname);
found:= Start > 0;
Inc(i);
end; {while}
if found then Result:= RightStr(FullName, Length(FullName)- Start + 2)
else Result:= '';
StringReplace(Result, '_', ' ',[]);
end;
I haven't dealt with upper and lowercase properly, but I hope you get the idea.
function TfrmCal.GetLastName(FullName: string): string;
var
i: integer;
found: boolean;
suffix: string;
marker: string;
begin
// Build the lists for the compare.
InitLists;
// Look at Suffixes and attach them to the LastName
i := 0;
found := False;
while (i < SuffixFix.Count) do
begin
if AnsiContainsStr(FullName, SuffixFix[i]) then
begin
suffix := '::' + trim(SuffixFix[i]);
FullName := ReplaceStr(FullName, SuffixFix[i], suffix);
found := True;
end;
inc(i);
if found then
break;
end;
// Look for LastName Markers
i := 0;
found := False;
while (i < LastNameMarkers.Count) do
begin
if AnsiContainsStr(FullName, LastNameMarkers[i]) then
begin
marker := trimright(LastNameMarkers[i]) + '::';
FullName := ReplaceStr(FullName, LastNameMarkers[i], marker);
found := True;
end;
inc(i);
if found then
break;
end;
FullName := GetLastWord(FullName);
FullName := ReplaceStr(FullName, '::', ' ');
LastNameMarkers.Clear;
SuffixFix.Clear;
Result := FullName;
end;
function TfrmCal.GetLastWord(const Str: string): string;
var
p: integer;
i: integer;
const
SPACE = #$20;
begin
p := 1;
for i := Length(Str) downto 1 do
if Str[i] = SPACE then
begin
p := i + 1;
break;
end;
Result := Copy(Str, p, MaxInt);
end;
These two functions together pull off what I needed to do. There is also the initlists function which is clunky and ugly and I need to work on so I didn't post it here.

Convert string with commas to float

Is there a built-in Delphi function which would convert a string such as '3,232.00' to float? StrToFloat raises an exception because of the comma. Or is the only way to strip out the comma first and then do StrToFloat?
Thanks.
Do you exactly know, that '.' is decimal separator and ',' is thousand separator (always)?
If so, then you should fill the TFormatSettings record and pass it to StrToFloat.
FillChar(FS, SizeOf(FS), 0);
... // filling other fields
FS.ThousandSeparator := ',';
FS.DecimalSeparator := '.';
V := StrToFloat(S, FS);
below is what i use. there might be more efficient ways, but this works for me. in short, no, i don't know of any built-in delphi function that will convert a string-float containing commas to a float
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
safeFloat
Strips many bad characters from a string and returns it as a double.
}
function safeFloat(sStringFloat : AnsiString) : double;
var
dReturn : double;
begin
sStringFloat := stringReplace(sStringFloat, '%', '', [rfIgnoreCase, rfReplaceAll]);
sStringFloat := stringReplace(sStringFloat, '$', '', [rfIgnoreCase, rfReplaceAll]);
sStringFloat := stringReplace(sStringFloat, ' ', '', [rfIgnoreCase, rfReplaceAll]);
sStringFloat := stringReplace(sStringFloat, ',', '', [rfIgnoreCase, rfReplaceAll]);
try
dReturn := strToFloat(sStringFloat);
except
dReturn := 0;
end;
result := dReturn;
end;
function StrToFloat_Universal( pText : string ): Extended;
const
EUROPEAN_ST = ',';
AMERICAN_ST = '.';
var
lformatSettings : TFormatSettings;
lFinalValue : string;
lAmStDecimalPos : integer;
lIndx : Byte;
lIsAmerican : Boolean;
lIsEuropean : Boolean;
begin
lIsAmerican := False;
lIsEuropean := False;
for lIndx := Length( pText ) - 1 downto 0 do
begin
if ( pText[ lIndx ] = AMERICAN_ST ) then
begin
lIsAmerican := True;
pText := StringReplace( pText, ',', '', [ rfIgnoreCase, rfReplaceAll ]); //get rid of thousand incidental separators
Break;
end;
if ( pText[ lIndx ] = EUROPEAN_ST ) then
begin
lIsEuropean := True;
pText := StringReplace( pText, '.', '', [ rfIgnoreCase, rfReplaceAll ]); //get rid of thousand incidental separators
Break;
end;
end;
GetLocaleFormatSettings( LOCALE_SYSTEM_DEFAULT, lformatSettings );
if ( lformatSettings.DecimalSeparator = EUROPEAN_ST ) then
begin
if lIsAmerican then
begin
lFinalValue := StringReplace( pText, '.', ',', [ rfIgnoreCase, rfReplaceAll ] );
end;
end;
if ( lformatSettings.DecimalSeparator = AMERICAN_ST ) then
begin
if lIsEuropean then
begin
lFinalValue := StringReplace( pText, ',', '.', [ rfIgnoreCase, rfReplaceAll ] );
end;
end;
pText := lFinalValue;
Result := StrToFloat( pText, lformatSettings );
end;
Try: StrToFloat(StringReplace('3,232.00', ',', '')
It should get rid of the commas before doing the conversion.
In C# / VB.NET I use would use something like decimal.convert("3,232.00", ",", "");
I know of no way to do the conversion without stripping out the extra characters. In fact, I have a special function in my library that strips out commas and currency symbols. So a actually call MyConverer.decimalConverter("$3,232.00");
I use a function which is able to handle the ',' and the '.' as decimalseparator...:
function ConvertToFloat(aNr: String; aDefault:Integer): Extended;
var
sNr, s3R, sWhole, sCent:String;
eRC:Extended;
begin
sNr:=ReplaceStr(sNr, ' ', '');
if (Pos('.', sNr) > 0) or (Pos(',', sNr) > 0) then
begin
// Get 3rd character from right
s3R:=LeftStr(RightStr(sNr, 3), 1);
if s3R <> DecimalSeparator then
begin
if not IsNumber(s3R) then
begin
s3R := DecimalSeparator;
sWhole := LeftSr(sNr, Length(sNr) - 3);
sCent := (RightStr(sNr, 2);
sNr := sWhole + DecimalSeparator + sCent;
end
else
// there are no decimals... add ',00'
sNr:=sNr + DecimalSeparator + '00';
end;
// DecimalSeparator is present; get rid of other symbols
if (DecimalSeparator = '.') and (Pos(',', sNr) > 0) then sNr:=ReplaceStr(sNr, ',', '');
if (DecimalSeparator = ',') and (Pos('.', sNr) > 0) then sNr:=ReplaceStr(sNr, '.', '');
end;
eRc := StrToFloat(sNr);
end;
I had the same problem when my Users need to enter 'scientific' values such as "1,234.06mV". Here there is a comma, a multiplier (m=x0.001) and a unit (V). I created a 'wide' format converter routine to handle these situtations.
Brian
Myfunction:
function StrIsFloat2 (S: string; out Res: Extended): Boolean;
var
I, PosDecimal: Integer;
Ch: Char;
STrunc: string;
liDots, liComma, J: Byte;
begin
Result := False;
if S = ''
then Exit;
liDots := 0;
liComma := 0;
for I := 1 to Length(S) do begin
Ch := S[I];
if Ch = FormatSettings.DecimalSeparator then begin
Inc (liDots);
if liDots > 1 then begin
Exit;
end;
end
else if (Ch = '-') and (I > 1) then begin
Exit;
end
else if Ch = FormatSettings.ThousandSeparator then begin
Inc (liComma);
end
else if not CharIsCipher(Ch) then begin
Exit;
end;
end;
if liComma > 0 then begin
PosDecimal := Pos (FormatSettings.DecimalSeparator, S);
if PosDecimal = 0 then
STrunc := S
else
STrunc := Copy (S, 1, PosDecimal-1);
if STrunc[1] = '-' then
Delete (S, 1, 1);
if Length(STrunc) < ((liComma * 3) + 2) then
Exit;
J := 0;
for I := Length(STrunc) downto 1 do begin
Inc(J);
if J mod 4 = 0 then
if STrunc[I] <> FormatSettings.ThousandSeparator then
Exit;
end;
S := ReplaceStr (S, FormatSettings.ThousandSeparator, '');
end;
try
Res := StrToFloat (S);
Result := True;
except
Result := False;
end;
end;
Using Foreach loop
public static float[] ToFloatArray()
{
string pcords="200.812, 551.154, 232.145, 482.318, 272.497, 511.752";
float[] spiltfloat = new float[pcords.Split(',').Length];
int i = 0;
foreach (string s in pcords.Split(','))
{
spiltfloat[i] = (float)(Convert.ToDouble(s));
i++;
}
return spiltfloat;
}
using lemda Expression to convert string comma seprated to float array
public static float[] ToFloatArrayUsingLemda()
{
string pcords="200.812, 551.154, 232.145, 482.318, 272.497, 511.752";
float[] spiltfloat = new float[pcords.Split(',').Length];
string[] str = pcords.Split(',').Select(x => x.Trim()).ToArray();
spiltfloat = Array.ConvertAll(str, float.Parse);
return spiltfloat;
}
procedure Edit1Exit(Sender: TObject);
begin
edit1.Text:=stringreplace(edit1.Text,'''','',[rfReplaceAll]);
if not IsValidDecimal( maskedit1.Text ) then
begin
showmessage('The Decimal entered -> '+edit1.Text+' <- is in the wrong format ');
edit1.SetFocus;
end;
end;
function IsValidDecimal(S:string):boolean;
VAR
FS: TFormatSettings;
DC: variant;
begin
//FS := TFormatSettings.Create('it-IT');
FS := TFormatSettings.Create('en-EN');
try
DC:=StrToFloat ( S, FS );
result:=true;
except
on e:exception do
result:=false;
end;
end;

Resources