Показать сообщение отдельно
  #4  
Старый 17.02.2011, 13:00
Doctor_Che Doctor_Che вне форума
Прохожий
 
Регистрация: 25.01.2011
Сообщения: 36
Репутация: 10
По умолчанию

Спасибо! Решилась проблема.
Код:
uses Crt;
const rz=[' ',',','.',';',':','?','!'];
var s,s1:string;
    a:array[1..50] of string;
    i,j,k,p:byte;
    f,b:boolean;
begin
clrscr;
writeln('Введите предложение:');
readln(s);
s:=s+',';//добавим запятую в конец
for i:=1 to length(s) do
if s[i] in rz then s[i]:=',';//заменим все разделители на запятые
while pos(',,',s)>0 do delete(s,pos(',,',s),1); //удалим повторяющиеся запятые
k:=0;
while pos(',',s)>0 do //пока есть запятые
 begin
  k:=k+1; //считаем слова
  a[k]:=copy(s,1,pos(',',s)-1);//записываем в массив
  delete(s,1,pos(',',s)); //удаляем
 end;
f:=false;//пока пары нет
i:=1;
while(i<k) and not f do//пока не предпоследнее слово и не нет пары
 begin
  b:=false;//это слово не пара?
  j:=i+1;//начинаем со следующего
  while(j<=k)and not b do //пока не конец или не пара
   begin
    s1:=''; //будем переворачивать слова
    for p:=length(a[j]) downto 1 do
    s1:=s1+a[j][p];
    if s1=a[i] then //если перевернутое совпадает с проверяемым
     begin
      b:=true;
      f:=true;
      writeln('Такая пара есть!');
      write(a[i],'  ',a[j]);
     end
    else j:=j+1; //если нет дальше
   end;
  if not b then i:=i+1;//если для этого слова пары нет, проверяем следующее
 end;
if not f then write('Такой пары нет!');
readln
end.
Ответить с цитированием