Строки-проблема

[Absent]

Ребят, дано стихотворение:

Да, искать такси - ад. Торт
с кофе не фокстрот. Не жалею,
не зову, не плачу. Ах, у печали
мерило,но лире мила чепуха.

нужно посчитать количество строк и найти предложения перевёртыши(предложения, которые если прочитать слева направо получится то же самое, что и с справа налево). Строки посчитал, а с перевёртышами проблема, кто может посмотрите код:

 Program LB5;
 uses crt;
 var sl:array[1..40] of string[20]  ;
    dsl:array[1..40] of integer;
    dms:array[1..800] of char;
    d,we,i,l,k,m,n,g,kol: integer;
 A:array[1..800] of char;
   b, s:set of char;
    wrd:text;

 begin
 clrscr;
 g:=0;
 for i:=1 to 40 do  sl[i]:='';
 s:=['А'..'п','р'..'я','-'];
  b:=['А'..'п','р'..'я','.'];
 assign(wrd,'c:\sp.txt');
 reset(wrd);
 n:=0;
 repeat
  n:=n+1;
  read(wrd,dms[n]);
  if eoln(wrd) then g:=g+1;
 until eof(wrd);
  close(wrd);
   For i:=1 to n do
   write(dms[i]);
   writeln;
   writeln;
  write('Колличество строк');
  writeln(g);
  {перевёртыши}
l:=0;
for i:=1 to n do
if dms[i] in b then
begin
l:=l+1;
A[n]:=dms[i];
end;
m:=1;
for i:=1 to n do
 if A[i] in b then
             begin
           we:=0;
                   if A[i]='.' then
                         begin
                         for k:=m to i do

                         if a[k]=a[m+i-k] then
                                          begin
                                          we:=we+1;
                                          if we=(i-m+1) then d:=d+1;
                                          end;
                         writeln(we)    ;
                         m:=i+1;

                        end;

               end;
end;

writeln('колличество переверт  ',d);

end.

[ОДИНОЧЕСТВО В СЕТИ]

function Palindrom(s:string):boolean;
var
  st,st1:string;
  i,n:integer;
begin
 n:=length(s);   {определение размера строки}
 for i:=1 to n do
 if (s[i] in ['a'..'z','A'..'Z']) then st:=st+s[i];
 n:=length(st)
  for i:=1 to n do st[i]:=UpCase(st[i]); {все символы введёной строки преобразуем
     в верхний регистр.}
  st1:='';
  for i:=1 to n do st1:=st1+copy(st,n-i+1,1); {перворачиваем слово}
  if st=st1 then palindrom:=true {если 2 строки одинаковы,
    то они являются палиндромами}
    else palindrom:=false;
end.

вот функа для латиницы возвращает true -если перевертыш false - в противном случае! переделай под русские буквы!

[Stilet]

Я бы так сделал:
1. Вылавливал бы по продложению.
2. Пускал выловленное в функцию, которая определяла полином.
Первое типа такого:

 s:='Да, искать такси - ад. Торт'+
 'с кофе не фокстрот. Не жалею,'+
 'не зову, не плачу. Ах, у печали'+
 'мерило,но лире мила чепуха.';
 e:='';
 for I := 1 to Length(s) do begin
   if s[i]<>'.' then  begin
    if s[i] in ['а'..'я','A'..'Я'] then
     e:=e+s[i];
   end   else begin
     writeln(e);
     e:='';
   end;
 end;

[LeBron]

Сообщение от Stilet

2. Пускал выловленное в функцию, которая определяла полином.

Хм... Вы имели ввиду палиндром? В целом нормальное решение, примерно так и надо в данном случае.

ОДИНОЧЕСТВО В СЕТИ, вашу функцию можно оптимизировать. Не понимаю, зачем лишнюю строку использовать, если можно проверить "вручную", по времени економнее в 2 с лишним раза, по памяти - почти в 2 раза... и по коду тоже

n:=length(st);er:=0;
for i:=1 to n div 2 do begin st[i]:=upcase(st[i]);st[n-i+1]:=upcase(st[n-i+1]);
if st[i]<>st[n-i+1] then inc(er);end;

просто проверим каждый символ сразу... дальше по обстоятельствам. В er будет хранится количество несовпадающих пар символов. Есл равно нулю - палиндром.

[Stilet]

Вы имели ввиду палиндром?

Не важно - главное чтобы костюмчик сидел ).

Насчет проверки на полиндромность:

  var s:string;
  i:integer;
begin
 s:='123455421';
 i:=1;
 while (i<(length(s) div 2))and(s[i]=s[length(s)+1-i]) do inc(i);
 if i<>(length(s) div 2) then writeln('Eto ne palindrom')
 else write('polindrom');
 readln;
  { TODO -oUser -cConsole Main : Insert code here }
end.

Тоже как видим ниче сложного. И лишнего тоже ничеж

[Absent]

Ребят ,спасибо большое, очень помогли