Avatar of scoopbh
scoopbh
 asked on

Copying only Upercase

Hi,

I want a code to copy one or more substrings from a string, I need only the part that is in Upercase. For example:

In this string: 'Delphi is a GREATER TOOL to develop and very CHEAP' I wish to copy the words GREATER TOOL CHEAP in a separeted string, like: mystring:= 'GREATER TOOL CHEAP'. And after I wish only the first characteres in uper case, the final result must be: 'Greater Tool Cheap'

Thanks in advance.
Delphi

Avatar of undefined
Last Comment
TName

8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
Mike Littlewood

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Mike Littlewood

Oops, better put in a Trim(Result) at the end
Russell Libby

You could also use a regular expression parser, which is perfectly suited  for this task.

http://users.adelphia.net/~rllibby/downloads/regexprex.zip

eg:

procedure TForm1.Button1Click(Sender: TObject);
var  reParse:       TRegExpr;
     listMatches:   TStringList;
     szText:        String;
     dwIndex:       Integer;
begin

  reParse:=TRegExpr.Create;
  try
     reParse.CaseSensitive:=True;
     reParse.Pattern:='\b[A-Z]+\b'; // <- this is all it takes to parse the data
     reParse.Source:='Delphi is a GREATER TOOL to develop and very CHEAP';
     if reParse.MatchFirst then
     begin
        listMatches:=TStringList.Create;
        try
           repeat
              listMatches.Add(reParse.MatchString);
           until not(reParse.MatchNext);
           for dwIndex:=0 to Pred(listMatches.Count) do
           begin
              listMatches[dwIndex]:=listMatches[dwIndex][1]+Copy(LowerCase(listMatches[dwIndex]), 2, MaxInt);
           end;
           szText:=StringReplace(Trim(listMatches.Text), #13#10, #32, [rfReplaceAll]);
           ShowMessage(szText);
        finally
           listMatches.Free;
        end;
     end;
  finally
     reParse.Free;
  end;

end;

---

Regards,
Russell


Mike Littlewood

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit1.Text := ReturnString(Edit1.Text);
end;

function ReturnString(sTemp: string): string;
var
     sl: TStringList;
     i, j: Integer;
begin
     Result := '';
     Trim(sTemp);
     sl := TStringList.Create;
     try
          sl.Delimiter := ' ';
          sl.DelimitedText := sTemp;
          for i := sl.Count - 1 downto 0 do
          begin
               for j := 1 to Length( sl.Strings[ i]) do
                    if not ( (sl.Strings[ i])[ j] in ['A'..'Z']) then
                    begin
                         sl.Delete(i);
                         break;
                    end;
          end;
          for i := 0 to sl.count - 1 do
               Result := Result + ' ' + sl.Strings[ i][ 1] + Lowercase( Copy( sl.Strings[ i], 2, Length( sl.Strings[ i])))

     finally
          FreeAndNil(sl)
     end;
     Result := Trim(Result);
end;
All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
Mike Littlewood

Slightly smaller and quicker

function ReturnString(sTemp: string): string;
var
  sl: TStringList;
  i, j: Integer;
begin
  Result := '';
  sl := TStringList.Create;
  try
    sl.Delimiter := ' ';
    sl.DelimitedText := sTemp;
      for i := sl.Count - 1 downto 0 do
      begin
        for j := 1 to Length( sl.Strings[ i]) do
          if not ( (sl.Strings[ i])[ j] in ['A'..'Z']) then
          begin
            sl.Delete(i);
            break;
          end;
      end;
    Result := sl.Text;
    Result := Trim( StringReplace(Result, #13#10, ' ', [rfReplaceAll]));
  finally
    FreeAndNil(sl)
  end;
end;
scoopbh

ASKER
They worked well.

But has a problem, if the string contains Ã Â Í Á Ó É the string in upercase is ignored, i.e.:
 'Delphi is a GREATER TOOL to develop and very CHEAP then JOÃO' it's only returns 'Greater Tool Cheap' and not 'Greater Tool Cheap João'
TName

Ok, here's one that does that also, but remember that the answers provided by the other experts had alredy fully answered the original request :)
If you want to experiment, you could combine two or more solutions (Or simply use widestrings with one of the previous solutions)


ShowMessage(ReturnString('Delphi is a GREATER TOOL to develop and very CHEAP then JOÃO'));

function ReturnString(const OrigStr: Widestring): WideString;
const
Allowed=[WideChar('A')..WideChar('Z'),
              WideChar('Ã'),
              WideChar('Â'),
              WideChar('Í'),
              WideChar('Á'),
              WideChar('Ó'),
              WideChar('É')];
var
  i, j: Integer;
  First:Boolean;
  tempStr,Str:WideString;
begin
  Result:='';
  i:=1;
  if Length(OrigStr)>0 then begin
    Str:=OrigStr+' ';  //life made easy, I know ;)
    while i < Length(Str) do begin
       try
         tempStr:=WideString('');
         if Str[i] in Allowed then begin
           First:=True;
           while Str[i]<>' ' do begin
             if Str[i] in Allowed then
               if First then
                 tempStr:=tempStr+Str[i]
               else
                 tempStr:=tempStr+AnsiLowerCase(Str[i])
             else
               tempStr:='';
             inc(i);
             First:=False;
           end;
           Result:=Result+tempStr;
           if i<Length(Str) then
             Result:=Result+' ';
         end;
       finally
         inc(i);
       end;
    end;
  end;
end;
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
TName

oh, and you don't need j (j: Integer).