Поиск предложений

[varvara16]

Здравствуйте. Помогите, пожалуйста, мне нужно отредактировать текст из TntMemo. Нужно убрать лишние пробелы, и выделить предложения. Но нужно обработать и исключительные ситуации такие как 3.5 и т.п. Заранее благодарю за помощь.

[puporev]

Поскольку текста не видим, будем считать, что конец предложения это комбинация символов точки и пробела. Тогда сначала удалим лишние пробелы, вставим пробел в конец текста и по указанному приципу разобьем текст на предложения, которые вставим в Мемо2.

procedure TForm1.Button1Click(Sender: TObject);
var s:string;
    i:integer;
begin
   s:=Memo1.Text;
   for i:=length(s)downto 1 do
   while pos('  ',s)>0  do  delete(s,pos('  ',s),1);//здесь в апострофах по 2 пробела, один удаляем
   s:=s+' ';//добавляем пробел
   while pos('. ',s) > 0 do //в апострофах точка+пробел
   begin
    Memo2.Lines.Add(copy(s,1,pos('. ',s)));
    delete(s,1,pos('. ',s)+1);
   end;

end;

[varvara16]

Спасибо огрооооооомное!!! Извините, а как можно одновременно проверить '. ' и '? ' и '! '. Спасибо за все.

[puporev]

Надо было мне сразу догадаться, а лучше Вам сразу написать. Сделайте так:

const c=['.','!','?'];
var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var s:string;
    i:integer;
begin
   s:=Memo1.Text;
   for i:=length(s)downto 1 do
   while pos('  ',s)>0  do  delete(s,pos('  ',s),1);
   s:=s+' '; i:=1;
   while i<=length(s)do
     begin
      if (s[i] in c)and(s[i+1]=' ') then
         begin
           Memo2.Lines.Add(copy(s,1,i));
           delete(s,1,i+1);
           i:=i-length(copy(s,1,i))+1;
         end;
      inc(i);
     end;
end;

end.

[varvara16]

Спасибо!!!!!!!!!!