I have a string, I set the coordinates for the selection of letters, but sometimes they mix up and I asked the coordinates with the numbers, how do I make that if for example '105DYUDXB28DYU13' had it done 'DYUDXBDYU'
tmpT.Put:=Trim(MidStr(S,8,6))+Trim(MidStr(S,37,3));
A solution with good performance is as follows (uses Character):
function RemoveNumbers(const AString: string): string;
var
i, j: integer;
begin
SetLength(result, AString.Length);
j := 0;
for i := 1 to AString.Length do
if not AString[i].IsDigit then
begin
inc(j);
result[j] := AString[i];
end;
SetLength(result, j);
end;
This function uses a few language and library features introduced after Delphi 7. To make this work in Delphi 7, you need to rewrite it slightly:
function RemoveNumbers(const AString: string): string;
var
i, j: integer;
begin
SetLength(result, Length(AString));
j := 0;
for i := 1 to Length(AString) do
if not (AString[i] in ['0'..'9']) then
begin
inc(j);
result[j] := AString[i];
end;
SetLength(result, j);
end;
The fine print: TCharHelper.IsDigit is Unicode-aware, and so it will return true for all Unicode digits. For instance, it will return true for
٣ (U+0663: ARABIC-INDIC DIGIT THREE),
੪ (U+0A6A: GURMUKHI DIGIT FOUR),
௫ (U+0BEB: TAMIL DIGIT FIVE),
៥ (U+17E5: KHMER DIGIT FIVE), and
᠗ (U+1817: MONGOLIAN DIGIT SEVEN).
If you only want to treat the characters '0'..'9' as digits, you can use the modernized version of the Delphi 7 test:
if not CharInSet(AString[i], ['0'..'9']) then
Also code with procedure and var parameter:
procedure RemoveNumbers(var Text: String);
var
Index: Integer;
begin
for Index := Length(Text) downto 1 do
if Text[Index] in ['0'..'9']
then Text := Copy(Text, 1, Index - 1) + Copy(Text, Index + 1, Length(Text) - Index);
end;
var
Text: String;
begin
Text := '105DYUDXB28DYU13';
RemoveNumbers(Text);
WriteLn(Text);
end.
Related
In Delphi 10.4, I have a hexadecimal representation of a string:
function TForm1.Button2Click(Sender: TObject);
var
i, nr : integer;
Input, HexStr, h: String;
begin
HexStr := '';
Input := Edit2.Text;
for i:=1 to Length(Input) do begin
nr := Ord(Input[i]);
h := IntToHex(nr, 0);
if Length(h) = 1 then
h := '0' + h;
HexStr := HexStr + h;
end;
Edit3.Text := HexStr;
end;
For "abc€", I get "61626320AC" here. Note the € sign converts to "20AC".
Now for converting it back to a normal string, I split that hex into 2-char pairs, using StrToInt() with a '$' prefix. I have no indicator for it being 4 chars long for an € sign, instead of 2 chars, and this breaks the euro sign:
How do I convert back such a hex string without breaking multibyte characters?
I have no indicator for it being 4 chars long for an € sign, instead of 2 chars
And because of that reason alone, you simply won't be able to convert "61626320AC" back to "abc€", because you don't know which hex codes are 2 digits and which are 4 digits, you didn't deliminate them. For instance, the hex codes 6162 and 6263 also represent valid Unicode characters, too.
As #TomBrunberg mentioned in comments, you can use 4-digit hex codes for every character, eg:
function TForm1.Button2Click(Sender: TObject);
var
i, nr : integer;
Input, HexStr, h: String;
begin
HexStr := '';
Input := Edit2.Text;
for i := Low(Input) to High(Input) do begin
nr := Ord(Input[i]);
h := IntToHex(nr, 4);
HexStr := HexStr + h;
end;
Edit3.Text := HexStr;
end;
Then you can convert back by splitting up the hex string into 4-character groups when calling StrToInt(), eg:
function TForm1.Button3Click(Sender: TObject);
var
i, nr : integer;
Output, HexStr, h: String;
begin
HexStr := Edit3.Text;
Output := '';
i := Low(HexStr);
while i <= High(HexStr) do begin
h := Copy(HexStr, i, 4);
nr := StrToInt('$' + h);
Output := Output + Char(nr);
Inc(i, 4);
end;
Edit2.Text := Output;
end;
Or, as #AmigoJack hinted at, you can use UTF-8 instead, eg:
function TForm1.Button2Click(Sender: TObject);
var
i, nr : integer;
HexStr, h: String;
Input: UTF8String;
begin
HexStr := '';
Input := UTF8String(Edit2.Text);
for i := Low(Input) to High(Input) do begin
nr := Ord(Input[i]);
h := IntToHex(nr, 2);
HexStr := HexStr + h;
end;
Edit3.Text := HexStr;
end;
function TForm1.Button3Click(Sender: TObject);
var
i, nr : integer;
HexStr, h: String;
Output: UTF8String;
begin
HexStr := Edit3.Text;
Output := '';
i := Low(HexStr);
while i <= High(HexStr) do begin
h := Copy(HexStr, i, 2);
nr := StrToInt('$' + h);
Output := Output + AnsiChar(nr);
Inc(i, 2);
end;
Edit2.Text := string(Output);
end;
Hello I want to split a simple string into a group of two characters then reverse them.
For example MyStringToBeReversed to two charachters each My St ri ng To Be Re ve rs ed
then reverse each splited two charachters to :
St := ts
ri := ir
etc ...
Here's the code I'm using but it only displays one charachter on memo lines
procedure TForm7.Button1Click(Sender: TObject);
var
MyString: string;
i: integer;
k: integer;
j: integer;
begin
MyString:= Edit1.Text;
for i:= 1 to length(MyString) do
Memo1.Lines.Add(MyString[i]);
// Move(Str[1], MyString, Length(Str));
end;
end.
This should do what you need
function ReverseEachTwoChars(AInput : string) : string;
var
i : integer;
begin
if(Odd(Length(AInput))) then
begin
SetLength(AInput, Length(AInput) + 1);
AInput[Length(AInput)] := 'A';
end;
SetLength(Result, Length(AInput));
i := 1;
while(i < Length(Result)) do
begin
Result[i] := AInput[i + 1];
Result[i + 1] := AInput[i];
Inc(i, 2);
end;
end;
Test:
ShowMessage(ReverseEachTwoChars('010203040506'));
Output:
102030405060
How can I split a string in Inno Setup?
Is there any special function in Inno Setup to split the string?
I want to get the following from the string '11.2.0.16':
tokens: array of string = ('11', '0', '2', '16');
Thanks in advance!
For anyone who prefers the function format, I have modified #cezarlamann's answer:
function StrSplit(Text: String; Separator: String): TArrayOfString;
var
i, p: Integer;
Dest: TArrayOfString;
begin
i := 0;
repeat
SetArrayLength(Dest, i+1);
p := Pos(Separator,Text);
if p > 0 then begin
Dest[i] := Copy(Text, 1, p-1);
Text := Copy(Text, p + Length(Separator), Length(Text));
i := i + 1;
end else begin
Dest[i] := Text;
Text := '';
end;
until Length(Text)=0;
Result := Dest
end;
I've been looking for the same thing today...
This one works just fine on Inno Setup Scripts. Paste this excerpt inside your script before the procedure/function which will call this "split" procedure.
You can also modify this onto a function, if you desire...
procedure Explode(var Dest: TArrayOfString; Text: String; Separator: String);
var
i, p: Integer;
begin
i := 0;
repeat
SetArrayLength(Dest, i+1);
p := Pos(Separator,Text);
if p > 0 then begin
Dest[i] := Copy(Text, 1, p-1);
Text := Copy(Text, p + Length(Separator), Length(Text));
i := i + 1;
end else begin
Dest[i] := Text;
Text := '';
end;
until Length(Text)=0;
end;
procedure Whatever();
var
str: String;
strArray: TArrayOfString;
i: Integer;
begin
Explode(strArray,str,'.');
for i:=0 to GetArrayLength(strArray)-1 do begin
{ do something }
end;
end;
Taken from here
Here's what I use:
procedure SplitString(S, Delim: string; var Dest: TArrayOfString);
var
Temp: string;
I, P: Integer;
begin
Temp := S;
I := StringChangeEx(Temp, Delim, '', true);
SetArrayLength(Dest, I + 1);
for I := 0 to GetArrayLength(Dest) - 1 do
begin
P := Pos(Delim, S);
if P > 0 then
begin
Dest[I] := Copy(S, 1, P - 1);
Delete(S, 1, P + Length(Delim) - 1);
end
else
Dest[I] := S;
end;
end;
This version avoids repeated array resizing by counting the delimiters using StringChangeEx and setting the array size only once. Since we then know the array size, we can just use a for loop. I also opted for Delete rather than Copy, which (IMO) makes the code easier to read. (This version also fixes the bug where the split does not occur correctly if the delimiter is longer than 1 character.)
If there is a possibility that the delimiter could also be right at the end of the string, then this is what I used (modified from #timyha's answer)
function StrSplit(Text: String; Separator: String): TArrayOfString;
var
i, p: Integer;
Dest: TArrayOfString;
begin
i := 0;
repeat
SetArrayLength(Dest, i+1);
p := Pos(Separator,Text);
if p > 0 then begin
Dest[i] := Copy(Text, 1, p-1);
Text := Copy(Text, p + Length(Separator), Length(Text));
i := i + 1;
//add an empty string if delim was at the end
if Text = '' then begin
Dest[i]:='';
i := i + 1;
end;
end else begin
Dest[i] := Text;
Text := '';
end;
until Length(Text)=0;
Result := Dest
end;
I have a random string of numbers
(numbers can only be used once, only from 1-9, almost any length(min 1,max 9)):
var
Input: String;
begin
Input := '431829576'; //User inputs random numbers
And now I need to get specified number to front. How about 5.
var
Number: Integer;
begin
Number := 5;
and function executes with result 543182976.
I don't have any ideas how to make a function like this, Thanks.
Do you mean like this?
function ForceDigitInFront(const S: string; const Digit: Char): string;
begin
result := Digit + StringReplace(S, Digit, '', []);
end;
A more lightweight solution is
function ForceDigitInFront(const S: string; const Digit: Char): string;
var
i: Integer;
begin
result := S;
for i := 1 to Length(S) do
if result[i] = Digit then
begin
Delete(result, i, 1);
break;
end;
result := Digit + result;
end;
You could do it this way :
function ForceDigitInFront(const S: string; const Digit: Char): string;
var
dPos : Integer;
begin
Result := s;
dPos := Pos( Digit,S);
if (dPos <> 0) then begin // Only apply Digit in front if Digit exists !?
Delete( Result,dPos,1);
Result := Digit + Result;
end;
end;
If Digit is not in input string, the digit is not added here, but change this if it does not fit your implementation.
Here is a solution that reduces the numer of String allocations needed, as well as checks if the digit is already in the front:
function ForceDigitInFront(const S: string; const Digit: Char): string;
var
dPos : Integer;
begin
Result := s;
for dPos := 1 to Length(Result) do
begin
if Result[dPos] = Digit then
begin
if dPos > 1 then
begin
UniqueString(Result);
Move(Result[1], Result[2], (dPos-1) * SizeOf(Char));
Result[1] := Digit;
end;
Exit;
end;
end;
end;
I have to write program that counts how many different letters are in string.
For example "abc" will give 3; and "abcabc" will give 3 too, because there are only 3 different letters.
I need to use pascal, but if you can help with code in different languages it would be very nice too.
Here is my code that does not work:
var s:string;
i,j,x,count:integer;
c:char;
begin
clrscr;
Readln(s);
c:=s[1];
x:=1;
Repeat
For i:=1 to (length(s)) do
begin
If (c=s[i]) then
begin
delete(s,i,1);
writeln(s);
end;
end;
c:=s[1];
x:=x+1;
Until length(s)=1;
Writeln(x);
x is the different letter counter;
Maybe my algorythm is very bad.. any ideas? Thank you.
You've got answers on how to do it, here's why your way doesn't work.
First of all intuitively you had a good idea: Start with the first char in the string, count it (you forgot to include the counting code), remove all occurrences of the same char in the string. The idea is inefficient, but it would work. You ran into trouble with this bit of code:
For i:=1 to (length(s)) do
begin
If (c=s[i]) then
begin
delete(s,i,1);
end;
end;
The trouble is, Pascal will take the Length(s) value when it sets up the loop, but your code changes the length of the string by removing chars (using delete(s,i,1)). You'll end up looking at bad memory. The secondary issue is that i is going to advance, it doesn't matter if it matched and removed an char or not. Here's why that's bad.
Index: 12345
String: aabbb
You're going to test for i=1,2,3,4,5, looking for a. When i is 1 you'll find a match, remove the first char, and your string is going to look like this:
Index: 1234
String: abbb
You're now testing with i=2, and it's not a match, because s[2] =b. You just skiped one a, and that given a is going to stay in the array an other round and cause your algorithm to count it twice. The "fixed" algorithm would look like this:
i := 1;
while i <= Length(s) do
if (c=s[i]) then
Delete(s,i,1)
else
Inc(i);
This is different: In the given example, if I found a match at 1, the cursor doesn't advance, so it sees the second a. Also because I'm using a while loop, not a for loop, I can't get in trouble with possible implementation details of the for loop.
Your algorithm has an other problem. After the loop that removes all occurrences of the first char in string you're preparing the next loop using this code:
c:=s[1];
The trouble is, if you feed this algorithm an string of the form aa (length=2, two identical chars), it's going to enter the loop, delete or occurrences of a (those turning s into an EMPTY string) and then attempt to read the first char of the EMPTY string.
One final word: Your algorithm should handle the empty string on input, returning an count=0. Here's the fixed algorithm:
var s:string;
i,count:integer;
c:char;
begin
Readln(s);
count:=0;
while Length(s) > 0 do
begin
Inc(Count);
c := s[1];
i := 1;
while i <= Length(s) do
begin
If (c=s[i]) then
delete(s,i,1)
else
Inc(i);
end;
end;
Writeln(Count);
Readln;
end.
I am a Delphi expert, so I don't quite know how restrictive plain Pascal is. Nevertheless, this is Delphi:
// Returns the number of *distinct* "ANSI" characters in Str
function NumChrs(const Str: AnsiString): integer;
var
counts: array[0..255] of boolean;
i: Integer;
begin
ZeroMemory(#counts[0], sizeof(boolean) * length(counts));
for i := 1 to length(Str) do
counts[ord(Str[i])] := true;
result := 0;
for i := 0 to high(counts) do
if counts[i] then
inc(result);
end;
The first line can be written
for i := 0 to high(counts) do
counts[i] := false;
if you cannot use the Windows API (or the Delphi FillChar function).
If you wish to have Unicode support (as in Delphi 2009+), you can do
// Returns the number of *distinct* Unicode characters in Str
function NumChrs(const Str: string): integer;
const
AllocBy = 1024;
var
FoundCodepoints: array of integer;
i: Integer;
procedure Push(Codepoint: integer);
var
i: Integer;
begin
for i := 0 to result - 1 do
if FoundCodepoints[i] = Codepoint then
Exit;
if length(FoundCodepoints) = result then
SetLength(FoundCodepoints, length(FoundCodepoints) + AllocBy);
FoundCodepoints[result] := Codepoint;
inc(result);
end;
begin
result := 0;
for i := 1 to length(Str) do
Push(ord(Str[i]));
end;
Here's my version. I'm not saying you'll get a great mark in your assignment if you hand this in.
function NumberOfUniqueChars(s: string): Integer;
var
i, j: Integer;
c: char;
begin
for i := 1 to Length(s) do
for j := i+1 to Length(s) do
if s[i]<s[j] then
begin
c := s[i];
s[i] := s[j];
s[j] := c;
end;
Result := 0;
for i := 1 to Length(s) do begin
if (i=1) or (s[i]<>c) then
inc(Result);
c := s[i];
end;
end;
And using a Delphi construct (not efficient, but clean)
function returncount(basestring: String): Integer;
var charstrings: TStringList;
I:Integer;
begin
Result := 0;
charstrings := TStringlist.create;
try
charstrings.CaseSensitive := False;
charstrings.Duplicates := DupIgnore;
for I := 1 to length(basestring) do
charstrings.Add(basestring[i]);
Result := charstrings.Count;
finally
charstrings.free;
end;
end;
Different languages are ok?
RUBY:
s = "abcabc"
=> "abcabc"
m = s.split(//)
=> ["a", "b", "c", "a", "b", "c"]
p = m & m
=> ["a", "b", "c"]
p.count
=> 3
A Delphi version. Same idea as #The Communist Duck Python version.
function GetNumChars(Str: string): Integer;
var
s: string;
c: Char;
begin
s := '';
for c in Str do
begin
if Pos(c, s) = 0 then
begin
s := s + c;
end;
end;
Result := Length(s);
end;
Just tossing in a set-alternative...
program CountUniqueChars;
{$APPTYPE CONSOLE}
uses
SysUtils;
var
InputStr: String;
CountedChr: Set of Char;
TotalCount: Integer;
I: Integer;
begin
Write('Text: ');
ReadLn(InputStr);
CountedChr := [];
TotalCount := 0;
for I := 1 to Length(InputStr) do
begin
Write('Checking: ' + InputStr[i]);
if (InputStr[i] in CountedChr)
then WriteLn(' --')
else begin
Include(CountedChr, InputStr[i]);
Inc(TotalCount);
WriteLn(' +1')
end;
end;
WriteLn('Unique chars: ' + IntToStr(TotalCount));
ReadLn;
end.
In Python, with explanation if you want it for any other language: (Since you wanted different languages)
s = 'aahdhdfrhr' #s is the string
l = [] #l is an empty list of some kind.
for i in s: #Iterate through the string
if i not in l: #If the list does not contain the character
l.append(i) #Add the character to the list
print len(l) #Print the number of characters in the list
function CountChars(const S:AnsiString):Integer;
var C:AnsiChar; CS:Set of AnsiChar;
begin
Result := 0;
CS := [];
for C in S do
if not (C in CS) then
begin
CS := CS + [C];
Inc(Result);
end;
end;