Множественный поиск текста Опции

[Unconnected]

Привет всем.

Нужно сделать так, чтобы по нажатию кнопки "Найти далее" в RichEdit't с текстом курсор переходил сначала на первое найденное искомое слово, по второму нажатию - на второе найденное исходное слово и так далее. Я сделал так:

Function poiskDOWN(ss:string):longint;
begin
  delete(ss,1,pDOWN);
  result:=pos(form13.sedit1.text,ss);
  pdown:=result+length(form13.sedit1.text);
end;

procedure TForm13.sButton3Click(Sender: TObject);
var p:TPoint;
begin
  if sedit1.text='' then begin
                           messagebox(handle,'Не введён текст для поиска!','Внимание!',0);
                           exit;
                         end;
  with form13 do
  begin
    if pos(sedit1.text,srichedit12.text)>0 then
    begin
      p.x:=poiskDOWN(sRichedit12.text);
      srichedit12.CaretPos:=p;
      srichedit12.setfocus;
    end
    else messagebox(handle,'Фрагмент не найден!','Внимание',0);
  end;
end;

Как мне кажется, алгоритм правильный, каждый раз функция отрезает от всего текста тот фрагмент, в котором уже был поиск. Но вот не работает почему-то... Первое вхождение находит, а потом курсор переходит куда глаза глядят

А, и ещё, переменная PDown изначально равна 0.

Сообщение отредактировано: Unconnected - 9.07.2009 16:16

[volvo]

Чуть-чуть подправленное решение из "DRKB -> VCL -> TRichEdit -> Поиск и замена -> TRichEdit — поиск текста"

function SearchForText_AndSelect(RichEdit: TRichEdit; SearchText: string;
         var StartPos: integer): Boolean;
var
  Position, Endpos: Integer;
begin
  result := False;

  with RichEdit do
  begin
    Endpos := Length(RichEdit.Text);
    Lines.BeginUpdate;
    if FindText(SearchText, StartPos, Endpos, [stMatchCase])<>-1 then
    begin
      Endpos   := Length(RichEdit.Text) - startpos;
      Position := FindText(SearchText, StartPos, Endpos, [stMatchCase]);
      Inc(StartPos, Length(SearchText));
      SetFocus;
      SelStart  := Position;
      SelLength := Length(SearchText);

      StartPos := SelStart + SelLength;
      result := True;
    end;
    Lines.EndUpdate;
  end;
end;

var
  pDown: integer = 0;

procedure TForm1.Button1Click(Sender: TObject);
begin

  if not SearchForText_AndSelect(sRichEdit12, sedit1.Text, pDown)
  then ShowMessage('Фрагмент не найден');

end;

Адаптируй к своим компонентам...