How can I count the number of occurrences of a certain character in a string in Delphi?
For instance, assume that I have the following string and would like to count the number of commas in it:
S := '1,2,3';
Then I would like to obtain 2 as the result.
You can use this simple function:
function OccurrencesOfChar(const S: string; const C: char): integer;
var
i: Integer;
begin
result := 0;
for i := 1 to Length(S) do
if S[i] = C then
inc(result);
end;
Even though an answer has already been accepted, I'm posting the more general function below because I find it so elegant. This solution is for counting the occurrences of a string rather than a character.
{ Returns a count of the number of occurences of SubText in Text }
function CountOccurences( const SubText: string;
const Text: string): Integer;
begin
Result := Pos(SubText, Text);
if Result > 0 then
Result := (Length(Text) - Length(StringReplace(Text, SubText, '', [rfReplaceAll]))) div Length(subtext);
end; { CountOccurences }
And for those who prefer the enumerator loop in modern Delphi versions (not any better than the accepted solution by Andreas, just an alternative solution):
function OccurrencesOfChar(const ContentString: string;
const CharToCount: char): integer;
var
C: Char;
begin
result := 0;
for C in ContentString do
if C = CharToCount then
Inc(result);
end;
This one can do the work for if you're not handling large text
...
uses RegularExpressions;
...
function CountChar(const s: string; const c: char): integer;
begin
Result:= TRegEx.Matches(s, c).Count
end;
You can use the benefit of StringReplace function as:
function OccurencesOfChar(ContentString:string; CharToCount:char):integer;
begin
Result:= Length(ContentString)-Length(StringReplace(ContentString, CharToCount,'', [rfReplaceAll, rfIgnoreCase]));
end;
Simple solution and good performance (I wrote for Delphi 7, but should work for other versions as well):
function CountOccurences(const ASubString: string; const AString: string): Integer;
var
iOffset: Integer;
iSubStrLen: Integer;
begin
Result := 0;
if (ASubString = '') or (AString = '') then
Exit;
iOffset := 1;
iSubStrLen := Length(ASubString);
while (True) do
begin
iOffset := PosEx(ASubString, AString, iOffset);
if (iOffset = 0) then
Break;
Inc(Result);
Inc(iOffset, iSubStrLen);
end;
end;
Ummm... Am I missing something? Why not just...
kSepChar:=',';//to count commas
bLen:=length(sLineToCheck);
bCount:=0;//The numer of kSepChars seen so far.
bPosn:=1;//First character in string is at position 1
for bPosn:=1 to bLen do begin
if sLineToCheck[bPosn]=kSepChar then inc(bCount);
end;//
Related
I have this simple operation in Java, where the string is split by new line and break.
String i= "Holidays
Great.
Bye";
String []linesArray = i.split("\\r?\\n");
I would like to obtain the same result in Delphi 2006.
Is it valid to use the following steps?
charArray[0] := '\\r';
charArray[1] := '\\n';
strArray := strA.Split(charArray);
I interpret your request like this: "Split a string at both CR and LF." which implies that CR+LF gives an empty string element. For instance, 'alpha'#13'beta'#10'gamma'#13#10'delta' yields the five elements 'alpha', 'beta', 'gamma', '', and 'delta'.
If so, and if you are using a non-ancient version of Delphi, this is really simple:
var S := 'alpha'#13'beta'#10'gamma'#13#10'delta';
var Parts := S.Split([#13, #10]);
for var Part in Parts do
ShowMessage(Part);
For old Delphi versions
The code above requires TStringHelper (crucially) and also makes use of inline variable declarations, for in loops, and generics.
For old Delphi versions, you can do it manually:
type
TStringArray = array of string;
function Split(const S: string): TStringArray;
var
Count: Integer;
const
Delta = 512;
procedure Add(const Part: string);
begin
if Length(Result) = Count then
SetLength(Result, Length(Result) + Delta);
Result[Count] := Part;
Inc(Count);
end;
var
p, i: Integer;
begin
Result := nil;
Count := 0;
p := 0; // previous delim
for i := 1 to Length(S) do
if S[i] in [#13, #10] then
begin
Add(Copy(S, Succ(p), i - p - 1));
p := i;
end;
Add(Copy(S, Succ(p)));
SetLength(Result, Count);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
S: string;
Parts: TStringArray;
i: Integer;
begin
S := 'alpha'#13'beta'#10'gamma'#13#10'delta';
Parts := Split(S);
for i := 0 to High(Parts) do
ShowMessage(Parts[i]);
end;
In a Delphi 10.4.2 Win32 VCL Application, and based on the question + solution here which provides a way to get the string representation of a Shortcut Key (but presumably with no possibility to also pass a SHIFTSTATE for the Shortcut Key) I wrote this code:
function MyGetSpecialShortcutName(ShortCut: TShortCut): string;
// gets shortcut name for e.g. VK_NUMPAD0 where TMenuItem.Shortcut gets the wrong shortcut name
var
ScanCode: Integer;
KeyName: array[0..255] of Char;
begin
Result := '';
FillChar(KeyName, SizeOf(KeyName), 0);
ScanCode := Winapi.Windows.MapVirtualKey(LoByte(Word(ShortCut)), 0) shl 16;
if ScanCode <> 0 then
begin
if Winapi.Windows.GetKeyNameText(ScanCode, KeyName, Length(KeyName)) <> 0 then
Result := KeyName;
end;
end;
function GetSpecialShortcutNameWithShiftState(const AScanCode: Word; const AShiftState: System.Classes.TShiftState = []): string;
begin
Result := MyGetSpecialShortcutName(Vcl.Menus.ShortCut(AScanCode, AShiftState));
end;
Usage:
Result := GetSpecialShortcutNameWithShiftState(VK_A, [ssCTRL]);
However, the Result is "A" where the expected Result should be "CTRL+A".
How to get the string representation of a ShortCut Key including the SHIFTSTATE?
The OP wants the key names fully localised, but for completeness I first show that the VCL already has a function to obtain a partly unlocalised string, namely, ShortCutToText in the Menus unit:
ShortCutToText(ShortCut(Ord('A'), [ssShift, ssAlt]))
This returns Shift+Alt+A on all systems.
Now, using the Win32 function GetKeyNameText already mentioned in the Q, it is easy to obtain a fully localised shortcut string:
function GetKeyName(AKey: Integer): string;
var
name: array[0..128] of Char;
begin
FillChar(name, SizeOf(name), 0);
GetKeyNameText(MapVirtualKey(AKey, 0) shl 16, #name[0], Length(name));
Result := name;
end;
function ModifierVirtualKey(AModifier: Integer): Integer;
begin
case AModifier of
Ord(ssShift):
Result := VK_SHIFT;
Ord(ssCtrl):
Result := VK_CONTROL;
Ord(ssAlt):
Result := VK_MENU;
else
Result := 0;
end;
end;
function ShortcutToString(AKey: Integer; AShiftState: TShiftState = []): string;
begin
Result := '';
for var Modifier in AShiftState do
begin
var ModifierKey := ModifierVirtualKey(Ord(Modifier));
if ModifierKey <> 0 then
Result := Result + IfThen(not Result.IsEmpty, '+') + GetKeyName(ModifierKey);
end;
Result := Result + IfThen(not Result.IsEmpty, '+') + GetKeyName(AKey);
end;
(Here I use a IfThen overload from StrUtils.)
Now,
ShortcutToString(Ord('A'), [ssShift, ssAlt])
returns SKIFT+ALT+A on my Swedish system. SKIFT is, as you might already have guessed, the Swedish name for the SHIFT key.
This question already has answers here:
Split a string into an array of strings based on a delimiter
(20 answers)
Closed 7 years ago.
Hy! What is the best way to find the first two Word in a string? For example, my string is an adress like : Cross Keys st 13. I need only 'Cross Keys' from it. Should I count the words in the string or there a better solution for that?
I can get the first and the last Word easily. I am new in Delphi. Thanks for the suggestions.
procedure SampleForm.ButtonClick(Sender: TObject);
var
st: string;
myString : string;
C: integer;
begin
st := Cross Keys st 13;
C:=LastDelimiter(' ',st);
myString := Copy(st,1,pos(' ',st)-1);
mystring:=Copy(st,C+1,length(st)-C);
The scope was delphi XE so string.split doesn't work. Instead you can use IStringTokenizer from HTTPUtil. Like this:
uses
HTTPUtil;
function GetFirstNWrods(const str: string; const delim: string; Numwords: Integer): string;
var
Tokenizer: IStringTokenizer;
begin
Result := '';
Tokenizer := StringTokenizer(str, delim);
while (Tokenizer.hasMoreTokens) and (Numwords > 0) do
begin
Result := Result + Tokenizer.nextToken + delim;
Dec(Numwords)
end;
System.Delete(Result, Length(Result) - Length(delim) + 1, Length(delim));
end;
Example of how to call the function:
procedure TForm1.FormCreate(Sender: TObject);
begin
Caption := GetFirstNWrods('1 2 3 4', ' ', 2);
end;
procedure TForm9.Button1Click(Sender: TObject);
begin
ShowMessage(someWord('first second and ...',1)); // show: first
ShowMessage(someWord('first second and ...',2)); //show: second
end;
function TForm9.someWord(sir: string; oneWord: integer): string;
var
myArray: TArray<string>;
begin
myArray := sir.Split([' ']); //myArray it's an Tstring of Words from sir
case oneWord of
1:
result := myArray[low(myArray)]; // result is first elemnt of myArray; low(myArray)=0
2:
begin
if high(myArray) > 0 then // high(myArray) index of last element of myArray
result := myArray[low(myArray) + 1] // result is second element of myArray
else
result := '';
end;
end;
end;
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.
Is there a method in Delphi to check if a string is a number without raising an exception?
its for int parsing.
and an exception will raise if one use the
try
StrToInt(s);
except
//exception handling
end;
function TryStrToInt(const S: string; out Value: Integer): Boolean;
TryStrToInt converts the string S, which represents an integer-type number in either decimal or hexadecimal notation, into a number, which is assigned to Value. If S does not represent a valid number, TryStrToInt returns false; otherwise TryStrToInt returns true.
To accept decimal but not hexadecimal values in the input string, you may use code like this:
function TryDecimalStrToInt( const S: string; out Value: Integer): Boolean;
begin
result := ( pos( '$', S ) = 0 ) and TryStrToInt( S, Value );
end;
var
s: String;
iValue, iCode: Integer;
...
val(s, iValue, iCode);
if iCode = 0 then
ShowMessage('s has a number')
else
ShowMessage('s has not a number');
Try this function StrToIntDef()
From help
Converts a string that represents an integer (decimal or hex notation) to a number with error default.
Pascal
function StrToIntDef(const S: string; Default: Integer): Integer;
Edit
Just now checked the source of TryStrToInt() function in Delphi 2007. If Delphi 7 dont have this function you can write like this. Its just a polished code to da-soft answer
function TryStrToInt(const S: string; out Value: Integer): Boolean;
var
E: Integer;
begin
Val(S, Value, E);
Result := E = 0;
end;
XE4 and newer:
for ch in s do
TCharacter.IsNumber(ch);
Don't forget:
uses System.Character
In delphi 7 you can use the Val procedure. From the help:
Unit: System
Delphi syntax: procedure Val(S; var V; var Code: Integer);
S is a string-type expression; it must be a sequence of characters that form a signed real number.
V is an integer-type or real-type variable. If V is an integer-type variable, S must form a whole number.
Code is a variable of type Integer.
If the string is invalid, the index of the offending character is stored in Code; otherwise, Code is set to zero. For a null-terminated string, the error position returned in Code is one larger than the actual zero-based index of the character in error.
use this function
function IsNumber(N : String) : Boolean;
var
I : Integer;
begin
Result := True;
if Trim(N) = '' then
Exit(False);
if (Length(Trim(N)) > 1) and (Trim(N)[1] = '0') then
Exit(False);
for I := 1 to Length(N) do
begin
if not (N[I] in ['0'..'9']) then
begin
Result := False;
Break;
end;
end;
end;
For older Delphi versions from delphi 5 help example:
uses Dialogs;
var
I, Code: Integer;
begin
{ Get text from TEdit control }
Val(Edit1.Text, I, Code);
{ Error during conversion to integer? }
if Code <> 0 then
MessageDlg('Error at position: ' + IntToStr(Code), mtWarning, [mbOk], 0);
else
Canvas.TextOut(10, 10, 'Value = ' + IntToStr(I));
end;
In some languages decimal separators are different (for example, '.' is used in English and ',' is used in Russian). For these cases to convert string to real number the following procedure is proposed:
function TryStrToFloatMultiLang(const S : String; out Value : Extended) : Boolean;
var
dc : char;
begin
Result := false;
dc := DecimalSeparator;
DecimalSeparator := '.';
try
Result := TryStrToFloat(S, Value);
except
DecimalSeparator := ',';
Result := TryStrToFloat(S, Value);
end;
DecimalSeparator := dc;
end;
Update
As #Pep mentioned TryStrToFloat catch exceptions, but it returns boolean value. So the correct code is:
function TryStrToFloatMultiLang(const S : String; out Value : Extended) : Boolean;
var
dc : char;
begin
Result := false;
dc := DecimalSeparator;
DecimalSeparator := '.';
Result := TryStrToFloat(S, Value);
if not Result then begin
DecimalSeparator := ',';
Result := TryStrToFloat(S, Value);
end;
DecimalSeparator := dc;
end;
When you using procedure
val(s, i, iCode);
and set value xd ....
val('xd', i, iCode)
as a result we obtain: 13
standard unit Variants
function VarIsNumeric(v:Variant):Boolean