[Doctor_Che]

Здравствуйте!
Помогите пожалуйста перевести перевести код из С в Pascal. В С никак не шарю...
Заранее спасибо.

Код:

/* В заданном предложении найти пару слов, из которых одно 

является обращением другого */ 

#include <stdio.h> 

#include <string.h> 

#define R "., ;:'\"()!?" /* символы - разделители */ 

main() 

{ 

char s[100],c[100],*p[50],*q; 

int i=0,j,k,n,fl=0; 

puts("\nВведите предложение"); 

gets(s); /* ввод предложения */ 

q=strtok(s,R); 

while(q) /* разбиваем предложение на слова */ 

{ 

p[i++]=q; 

q=strtok(NULL,R); 

} 

for(j=0;j<i;j++) /* перебираем слова */ 

for(k=j+1;k<i;k++) 

{ 

if(!fl) /* проверка флага */ 

{ 

for(n=0;n<strlen(p[k]);n++) /* переворачиваем слово */ 

{ 

c[n]=*(p[k]+(strlen(p[k])-n-1)); 

} 

c[n]='\0'; 

if(!strcmp(c,p[j])) /* если слова одинаковы, то выводим */ 

{ 

puts("Ответ:"); 

puts(p[j]); 

puts(p[k]); 

fl=1; /* устанавливаем флаг */ 

} 

} 

} 

if(!fl) puts("\nНет таких слов"); 

} 

[friz]

Как я понимаю, программа должна выделить слова из предложения, и проверить есть ли слова которые читаются одинокого слева направо и справа налево?
вот примерчик:
на форме, edit1, memo1, button1
в эдит вводим строку, в мемо отображаются нужные слова

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
TDelim=set of Char;
TArrayOfString=Array of String;

  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function fcToParts(sString:String;tdDelim:TDelim):TArrayOfString ;  //функция разбора строки на слова
var iCounter,iBegin:Integer;
begin
if length(sString)>0 then
begin
include(tdDelim,#0);
iBegin:=1;
SetLength(Result,0);
For iCounter:=1 to Length(sString)+1 do
  begin
   if (sString[iCounter] in tdDelim) then
    begin
     SetLength(Result,Length(Result)+1);
     Result[Length(Result)-1]:=Copy(sString,iBegin,iCounter-iBegin);
     iBegin:=iCounter+1;
    end;
end;
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
StrArr:TArrayOfString;
i,k,z:integer;
s:string;
zard :TDelim;
t:char;
begin
zard:=[' ',',','.'];  //разделители
t:=edit1.Text[length(edit1.Text)]; //последний символ строки
if not (t in zard) then edit1.Text:=Edit1.Text+' '; // если последний символ не разделитель то добавляем пробел
StrArr:=fcToParts(edit1.Text,[' ',',','.']);
for i:=1 to Length(StrArr) do
  begin
  s:='';
     for k:=length(StrArr[i]) downto 1 do
        begin
          s:=s+StrArr[i][k]; //переворачиваем слово
        end;
  if StrArr[i]=s then memo1.Lines.Add(StrArr[i]);  // проверяем равенство, если ок то выводим в мемо
  end;

end;

end.

[Doctor_Che]

Спасибо огромное!!!
Но по заданию необходимо на Паскале сделать. И потом еще задания по программе выполнять.
Можете поправить пожалуйста на Паскаль. Очень надо.

[Doctor_Che]

Спасибо! Решилась проблема.

Код:

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.