Поиск текста с позиции найденного слова "+1"

[artemavd]

Всем привет! Такое вот замысловатое название темы. Но, суть вопроса попроще будет. Итак, есть некий файл. В нем есть какой-то текст, с небольшими элементами таблицы, который в формате RTF и грузится в RichEdit (это сделано). Есть 3 слова-выражения, от которых должен "отталкиваться" поиск. Эти три слова-выражения находятся друг за другом, но между ними заключен некий текст. Например, есть выражение в тексте "в отношении ", которое сначала нужно найти, а потом скопировать все, что идет после этого выражения до второго ключевого слова. Потом от второго ключевого слова до третьего. Потом от третьего одно слово (одно т.к. там идет только номер и все). Скопированные тексты между ключевыми словами скопировать куда-нибудь, например в эдиты. Пока я сделал удаление пробелов через ReplaceAll и поиск текста через компонент FindDialog1:

procedure TForm1.dlgFind1Find(Sender: TObject);
var
 FoundAt: LongInt;
 StartPos, ToEnd: Integer;
begin
 with sRichEdit1 do
 begin
  if SelLength <> 0 then
     StartPos := SelStart + SelLength
  else
  StartPos := 0;
  ToEnd := Length(Text) - StartPos;
  FoundAt := FindText(Form1.dlgFind1.FindText, StartPos, ToEnd, [stMatchCase]);
  if FoundAt <> -1 then
   begin
    SetFocus;
    SelStart := FoundAt;
    SelLength := Length(Form1.dlgFind1.FindText);
   end;
 end;
end;

вызов диалога:

procedure TForm1.sSpeedButton4Click(Sender: TObject);
begin
 Form1.dlgFind1.Execute;
 Form1.dlgFind1.FindText:=' ' + Form1.sRadioButton2.Caption + ' ';
end;

Возникло несколько вопросов:
1. Как скрыть диалог, чтобы он не появлялся, а поиск работал?
2. Почему не срабатывает строка кода

Form1.dlgFind1.FindText:=' ' + Form1.sRadioButton2.Caption + ' ';

[Человек_Борща]

т.е. в RichEdit находится что-то подобное:

<Left>left Text<Center>center text<right>1

и нужно вытащить:
left Text
center text
1

и распихать по контролам?

[artemavd]

Ага, верно понял меня. Есть идеи как это сделать? Код который я привел выше, ищет слово введенное через диалог только.

[Человек_Борща]

Да есть,
AnsiPos,Copy,Delete вот реализация:

procedure TForm1.Button1Click(Sender: TObject);
const
  aMsg = '<Left>left Text<Center>center text<right>1';
  a1 = '<Left>';
  a2 = '<Center>';
  a3 = '<right>';
var
  sTemp: string;
  p: Integer;
  ResultS: string;
begin
  sTemp := aMsg;
  //ищем первый слово
  p := AnsiPos(a1, sTemp);
  //Копируем(Позиция слова+длинная слова, кол-во коп. знаков(Позция второго слова - длинная этого слова +1))
  ResultS := Copy(sTemp, p + Length(a1), AnsiPos(a2, sTemp) - Length(a2) + 1);
  //Удаяем скопированный участок, и повторяем схуму
  Delete(sTemp, p, AnsiPos(a2, sTemp) - 1);

  //Получаем текст между center & Right
  p := AnsiPos(a2, sTemp);
  ResultS := ResultS + ' ' + Copy(sTemp, p + Length(a2), AnsiPos(a3, sTemp) - Length(a3) - 2);
  Delete(sTemp, p, AnsiPos(a3, sTemp) - 1);

  //Получаем последнее
  p := AnsiPos(a3, sTemp);
  ResultS := ResultS + ' ' + Copy(sTemp, p + Length(a3), 1);
  Delete(sTemp, p, Length(a3));

  ShowMessage(ResultS);
end;

если 2 тега, то можно ещё упростить до такого:

//фантизия закончилась ;)  На имена функций
function GetText1(OpenTag,aText,CloseTag:string):string;
begin
  Result:=Copy(aText,AnsiPos(OpenTag,aText)+Length(OpenTag),AnsiPos(CloseTag,aText)-Length(CloseTag)-1);
end;


procedure TForm1.Button2Click(Sender: TObject);
begin
ShowMessage(GetText1('<1>',Edit1.Text,'<2>'));
end;

[artemavd]

Код отличный и работает вроде бы как надо). Только один вопрос: после третьего тэга добавляется весь текст, который идет после слова, идущего за третьим тэгом. Не могу найти в коде где убрать, чтобы остальной текст не добавлялся. Покажи где подправить? А так, работает вроде как надо). Чтобы бралось только одно слово идущее после третьего тэга.

[Serge_Bliznykov]

после третьего тэга добавляется весь текст, который идет после слова, идущего за третьим тэгом.

не, неправда Ваша..
после третьего тега добавляется исключительно ОДНА БУКВА из текста!

  ResultS := ResultS + ' ' + Copy(sTemp, p + Length(a3), 1);

Добавлено
выделить одно слово от третьго ключа до первого пробела можно так:

  //Получаем последнее
  p := AnsiPos(a3, sTemp);
  sTemp := Copy(sTemp, p + Length(a3), Length(sTemp) - p - Length(a3)+ 1);
  if Pos(' ', sTemp)>1 then
     ResultS := ResultS + ' ' + Copy(sTemp, 1, Pos(' ', sTemp)-1);
  ShowMessage('Last word = ' +  Copy(sTemp, 1, Pos(' ', sTemp)-1)  );

[artemavd]

Полный код будет такой:

procedure TForm1.Button1Click(Sender: TObject);
const
  aMsg = '<Left>left Text<Center>center text<right>1';
  a1 = '<Left>';
  a2 = '<Center>';
  a3 = '<right>';
var
  sTemp: string;
  p: Integer;
  ResultS: string;
begin
  sTemp := aMsg;
  //ищем первый слово
  p := AnsiPos(a1, sTemp);
  //Копируем(Позиция слова+длинная слова, кол-во коп. знаков(Позция второго слова - длинная этого слова +1))
  ResultS := Copy(sTemp, p + Length(a1), AnsiPos(a2, sTemp) - Length(a2) + 1);
  //Удаяем скопированный участок, и повторяем схуму
  Delete(sTemp, p, AnsiPos(a2, sTemp) - 1);

  //Получаем текст между center & Right
  p := AnsiPos(a2, sTemp);
  ResultS := ResultS + ' ' + Copy(sTemp, p + Length(a2), AnsiPos(a3, sTemp) - Length(a3) - 2);
  Delete(sTemp, p, AnsiPos(a3, sTemp) - 1);

//Получаем последнее
  p := AnsiPos(a3, sTemp);
  sTemp := Copy(sTemp, p + Length(a3), Length(sTemp) - p - Length(a3)+ 1);
  if Pos(' ', sTemp)>1 then
     ResultS := ResultS + ' ' + Copy(sTemp, 1, Pos(' ', sTemp)-1);
  ShowMessage('Last word = ' +  Copy(sTemp, 1, Pos(' ', sTemp)-1)  );
end;

????

[Человек_Борща]

в принципе я и так знал что, чтобы найти последнее слово надо чтобы после последнего было что-нибудь, что отделяет это слово от остального. Возможно это пробел. Что собственно и делается.

, да код дополнен приавильно и работает.

[artemavd]

Не, а у меня он как-то не так работает. У меня в сообщении выводится самое первое слово в тексте. Если не трудно, то покажите полностью код? А то может я неправильно располагаю что-то.

[Аватар]

Как вариант

const a: array [1..4] of String = ('<Left>','<Center>','<right>',' ');
var i,j,k: Integer;
    s,ResultS: string;
begin
  ResultS:='';
  s:='...<Left>left Text<Center>center text<right>12 ...';
  for i:=1 to 3 do begin
    j:=Pos(a[i],s);
    if j=0 then Break;
    k:=Pos(a[i+1],s);
    if (k=0) or (k<j) then Break;
    ResultS:=ResultS+Copy(s,j+Length(a[i]),k-j-Length(a[i]))+' ';
    s:=Copy(s,k,Length(s)-k);
  end;
  if ResultS<>'' then ResultS:=Copy(ResultS,1,Length(ResultS)-1);
  ShowMessage(ResultS);
end;

или боле точно

const a: array [1..4] of String = ('<Left>','<Center>','<right>',' ');
var i,j: Integer;
    s,ResultS: string;
begin
  ResultS:='';
  s:='...<Left>left Text<Center>center text<right>12 ...';
  for i:=1 to 3 do begin
    j:=Pos(a[i],s);
    if j=0 then Break;
    s:=Copy(s,j+Length(a[i]),Length(s)-j-Length(a[i])+1);
    j:=Pos(a[i+1],s);
    if (j=0) and (i<3) then Break;
    if j=0 then ResultS:=ResultS+s+' '
           else ResultS:=ResultS+Copy(s,1,j-1)+' ';
    s:=Copy(s,j,Length(s)-j+1);
  end;
  if ResultS<>'' then ResultS:=Copy(ResultS,1,Length(ResultS)-1);
  ShowMessage(ResultS);
end;