Перечислить все слова заданного предложения, которые состоят из тех же букв что и первое слово предложения — Delphi(Делфи)

type
 TMyStrArr = array of string;
 
 function GetWordsBy1stWord(str: string): TMyStrArr;
 
 function WordsInStrA(s: string): integer;
 var
 b: boolean;
 i,j,k: integer;
 str: string;
 begin
 str:=s+' ';
 b:=false;
 j:=Length(str);
 k:=0;
 for i:=1 to j do
 begin
 if (Ord(str[i])=32)and b then
 begin
 Inc(k);
 b:=false;
 end else if (Ord(str[i])>64)and(not b) then b:=true;
 end;
 Result:=k;
 end;
 
 function GetWordByNum(x: string; num: integer): string;
 var
 i,k,l: integer;
 begin
 if (num<=WordsInStrA(x))and(num>1) then
 begin
 l:=0;
 for i:=1 to num-1 do
 begin
 repeat
 Inc(l);
 until x[l]=' ';
 repeat
 Inc(l);
 until x[l]<>' ';
 end;
 k:=l-1;
 if l<Length(x) then
 begin
 repeat
 Inc(k)
 until x[k]=' ';
 Result:=Copy(x,l,k-l);
 end else Result:=''+x[l];
 end else if Num=1 then
 begin
 l:=0;
 repeat
 Inc(l);
 until x[l]=' ';
 Result:=Copy(x,1,l-1);
 end else Result:='NaN';
 end;
 
 var
 x: set of Char;
 back: string;
 c,res: TMyStrArr;
 b: boolean;
 i,j,count: integer;
 begin
 if WordsInStrA(str)=1 then
 begin
 SetLength(res,1);
 res[0]:=GetWordByNum(str,1);
 Result:=res;
 end else if WordsInStrA(str)<1 then
 begin
 SetLength(res,1);
 res[0]:='NaN';
 Result:=res;
 end else
 begin
 SetLength(c,WordsInStrA(str));
 SetLength(res,WordsInStrA(str));
 for i:=0 to WordsInStrA(str)-1 do
 c[i]:=GetWordByNum(str,i+1);
 back:=GetWordByNum(str,1);
 x:=[back[1]];
 for i:=1 to Length(back) do
 if (not (back[i] in x))or(back[i]<>' ') then x:=x+[back[i]];
 x:=x+[' '];
 count:=0;
 for i:=0 to WordsInStrA(str)-1 do
 begin
 for j:=1 to Length(c[i]) do
 begin
 b:=c[i,j] in x;
 if not b then break;
 end;
 if b then
 begin
 res[count]:=c[i];
 Inc(count);
 end
 end;
 c:=res;
 SetLength(res,count);
 for i:=0 to count-1 do
 res[i]:=c[i];
 Result:=res;
 end;
 end;