[Dima170792]

Доброго времени суток ув.форумчане!Нужна ваша помощь в решении задачи по программированию.Язык програмирования-Delphi7.Задача состоит в следующем:Дан текст.Найти все палиндромы(слова-перевёртыши)в етом тексте.У меня неполучаеться перевод из паскаля в Delphi7-ниже исходный код! если несложно помогите организовать оконное приложение:

Код:

var i:byte;
    s1:string;
begin
s1:='';
for i:=length(s) downto 1 do
s1:=s1+s[i];
if s=s1 then Pal:=true
else Pal:=false;
end;
 
begin;
writeln('Введите слова разделенными пробелами: ');
readln(s);
while pos('  ',s)>0 do
delete(s,pos('  ',s),1);
i:=length(s);
s1:='';
while s[i]<>' ' do
 begin
  s1:=s[i]+s1;
  i:=i-1;
 end;
k:=0;
while pos(' ',s)>0 do
 begin
 s2:=copy(s,1,pos(' ',s)-1);
 if (s2<>s1)and Pal(s2) then
 begin
  write(s2,' ');
  k:=k+1;
  end;
 delete(s,1,pos(' ',s));
 end;
if k=0 then
write('В строке не найдено палиндрома! ');
readln
end.

с использованием едитов или мемо в качестве полей ввода-вывода.Заранее благодарен!

[angvelem]

Попробуй, может подойдёт:

Код:

function Palindrom(S : String) : Boolean;
var
  I  : Integer;
  s1 : String;
begin
  s1 := '';
  for I := Length(s) downto 1 do
    s1 := s1 + s[i];

  Result := s = s1;
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  S, S1, S2 : String;
  I, K      : Integer;
begin;
  if Edit1.Text = '' then
    Exit;

  S := Edit1.Text;
  while Pos('  ', S) > 0 do
    delete(S, Pos('  ', S), 1);

  I := Length(S);

  s1 := '';
  while S[i] <> ' ' do
  begin
    S1 := S[i] + S1;
    dec(I);
  end;

  K := 0;
  while Pos(' ', S) > 0 do
  begin
    S2 := Copy(S, 1, Pos(' ', S) - 1);
    if (S2 <> S1) and Palindrom(S2) then
    begin
      S2 := ' ';
      inc(K);
    end;
    delete(S, 1, Pos(' ', S));
  end;

  if K = 0 then
    ShowMessage('В строке не найдено палиндрома! ');
end;

[Dima170792]

Попробовал-но видимо в коде чего то не хватает-постоянно пишет"в строке не найдено полиндрома" -даже если он там есть!

[angvelem]

У меня с такой строкой "Он дивен, палиндром, и ни морд, ни лап не видно" всё работает.

[lmikle]

angvelem, читай вопрос внимательно. Человеку надо найти все слова-палиндромы, а не текст.

[angvelem]

Судя по коду обрабатывается фраза содержащая пробелы, я предположил, что палиндромом выступает именно фраза а не отдельное слово, накопления найденных палиндромов в этом коде, что то не замечаю (не считая переменной K). Как быть? Пойду застрелюсь.

[ART]

Код:

function getPalindromes(text: string): TStringList;
var
 str: string;
 i, j: integer;
 S, R: TStringList;
begin
 S := TStringList.Create;
 R := TStringList.Create;
 S.Text := StringReplace(Trim(text), ' ', #13#10, [rfReplaceAll]);
 for i := 0 to S.Count - 1 do begin
  str := '';
  S.Strings[i] := AnsiLowerCase(Trim(S.Strings[i]));
  if S.Strings[i] <> '' then begin
   for j := Length(S.Strings[i]) downto 1 do
    str := str + S.Strings[i][j];
   if str = S.Strings[i] then R.Add(str);
  end;
 end;
 S.Free;
 Result := R;
end;

Код:

 ShowMessage(IntToStr(getPalindromes('123321 abcba').count));