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

Категория: Delphi/Pascal
2011-08-22 23:33:32
code: #delphi
  1. type
  2.  TMyStrArr = array of string;
  3.  
  4.  function GetWordsBy1stWord(str: string): TMyStrArr;
  5.  
  6.  function WordsInStrA(s: string): integer;
  7.  var
  8.  b: boolean;
  9.  i,j,k: integer;
  10.  str: string;
  11.  begin
  12.  str:=s+' ';
  13.  b:=false;
  14.  j:=Length(str);
  15.  k:=0;
  16.  for i:=1 to j do
  17.  begin
  18.  if (Ord(str[i])=32)and b then
  19.  begin
  20.  Inc(k);
  21.  b:=false;
  22.  end else if (Ord(str[i])>64)and(not b) then b:=true;
  23.  end;
  24.  Result:=k;
  25.  end;
  26.  
  27.  function GetWordByNum(x: string; num: integer): string;
  28.  var
  29.  i,k,l: integer;
  30.  begin
  31.  if (num<=WordsInStrA(x))and(num>1) then
  32.  begin
  33.  l:=0;
  34.  for i:=1 to num-1 do
  35.  begin
  36.  repeat
  37.  Inc(l);
  38.  until x[l]=' ';
  39.  repeat
  40.  Inc(l);
  41.  until x[l]<>' ';
  42.  end;
  43.  k:=l-1;
  44.  if l<Length(x) then
  45.  begin
  46.  repeat
  47.  Inc(k)
  48.  until x[k]=' ';
  49.  Result:=Copy(x,l,k-l);
  50.  end else Result:=''+x[l];
  51.  end else if Num=1 then
  52.  begin
  53.  l:=0;
  54.  repeat
  55.  Inc(l);
  56.  until x[l]=' ';
  57.  Result:=Copy(x,1,l-1);
  58.  end else Result:='NaN';
  59.  end;
  60.  
  61.  var
  62.  x: set of Char;
  63.  back: string;
  64.  c,res: TMyStrArr;
  65.  b: boolean;
  66.  i,j,count: integer;
  67.  begin
  68.  if WordsInStrA(str)=1 then
  69.  begin
  70.  SetLength(res,1);
  71.  res[0]:=GetWordByNum(str,1);
  72.  Result:=res;
  73.  end else if WordsInStrA(str)<1 then
  74.  begin
  75.  SetLength(res,1);
  76.  res[0]:='NaN';
  77.  Result:=res;
  78.  end else
  79.  begin
  80.  SetLength(c,WordsInStrA(str));
  81.  SetLength(res,WordsInStrA(str));
  82.  for i:=0 to WordsInStrA(str)-1 do
  83.  c[i]:=GetWordByNum(str,i+1);
  84.  back:=GetWordByNum(str,1);
  85.  x:=[back[1]];
  86.  for i:=1 to Length(back) do
  87.  if (not (back[i] in x))or(back[i]<>' ') then x:=x+[back[i]];
  88.  x:=x+[' '];
  89.  count:=0;
  90.  for i:=0 to WordsInStrA(str)-1 do
  91.  begin
  92.  for j:=1 to Length(c[i]) do
  93.  begin
  94.  b:=c[i,j] in x;
  95.  if not b then break;
  96.  end;
  97.  if b then
  98.  begin
  99.  res[count]:=c[i];
  100.  Inc(count);
  101.  end
  102.  end;
  103.  c:=res;
  104.  SetLength(res,count);
  105.  for i:=0 to count-1 do
  106.  res[i]:=c[i];
  107.  Result:=res;
  108.  end;
  109.  end;
Поделиться:

Похожие статьи:

теги: студенты, консольное приложение, работа со строками