
17.02.2011, 13:00
|
Прохожий
|
|
Регистрация: 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.
|