procedure TForm1.Button3Click(Sender: TObject);
var Spos,i,n,p:integer;
begin
i := Length(RichEdit1.Text);
Label1.Caption := inttostr(i);
Spos:=RichEdit1.SelStart;
n := Pos(AnsiLowerCase(Edit1.Text), AnsiLowerCase(copy(RichEdit1.Lines.Text, Spos+1, length(Richedit1.Lines.Text))))+Spos-1;

p:=0;
while n > 0 do
begin
Label4.Caption := ''+inttostr(n);
if n > 0
then begin
richEdit1.SelStart := n;
Label1.Caption := 'Текст найден'+inttostr(richEdit1.SelStart);
n := Pos(AnsiLowerCase(Edit1.Text), AnsiLowerCase(copy(RichEdit1.Lines.Text, Spos+1, length(Richedit1.Lines.Text))))+Spos-1;
Spos := RichEdit1.SelStart+RichEdit1.SelLength+1;

RichEdit1.SelLength:=Length(Edit1.Text);
RichEdit1.SelAttributes.Color := 808080;
Label2.Caption := inttostr(n);


end
else
Label1.Caption := 'Текст ненайден';
end;
end;
end.


Необходимо Открыть файл. Вывести его в РичЕдит. И осуществить поиск слова которые заданы в Едите. Все найденные слова окрасить в другой цвет.
Напила вот такое. Работает. Но цикл циклится, потмоу что никак немогу подобрать правельно условия на выход. А еще pos иногда ищет не те слова. Что делать?

SelIdx:= 0; // позиция в эдите
//Идешь в цикле по всем строкам эдита 
for i:= 0 to Rich.Lines.Count - 1 do
begin
  // далее разбираешь каждую строку
  s:= Rich.Lines[i];
  // проверяешь наличие искомого в строке     
  p:= Pos(AnsiUpperCase('искомое слово сочетание', AnsiUpperCase(s)));
  while p > 0 do
  begin    
    Inc(SelIdx, p); // накапливаем позицию
    // нашли подкрашиваем
    if p > 0 then 
    begin
      Rich.SelLength:=Length('искомое слово сочетание');
      Rich.SelAttributes.Color := 808080;
    end;
    Delete(s, 1, p + Length('искомое слово сочетание'));
    p:= Pos(AnsiUpperCase('искомое слово сочетание', AnsiUpperCase(s)));
  end;
end;

что то типа такого

Не пробовал в Делфи, но на С мы и правда сначала все придложение разбивали на слова с пмощюь другой строки:

char *dlm=" ,.!?"//это типа были разделители

потом присваиваем еще одному чару

char *promchar;//'промежуточная строка

набор символов строки до разделителя:

promchar=strtok(stroka,dlm)//это начальная строка где нам дано предложение...
While(promchar!=0)//не равно 0
{//begin

и тута сравниваем и promchar следуещее слово
promchar=strtok(0,dlm);//хотя strtok(null,dlm); в литературе но у меня не шло
}//end;

И тута у меня возникает вопрос, кажется в делфе есть все таки для Stringa оператор сравнения, я точно не уварен, но в отличии от С, С++... есть, по этому у меня пораждаются мысль что можно всетаки написать if str1=str2 then ...
Или я ошибаюсь?
Хотя у меня возникает другой вопрос, а как тута с буквами большими и маленькими, они же отличаются?

все так.....

есть функции преобразования строк к верхнему/нижнему регистру, в Си есть функции сравнения, с параметром, исключающим регистр.

2DIR3ct0r

Пасибо) После обьеденения наших кодов все работает почти нормально. Только одна проблема. Если использовать условие While n >0 Он будет циклится так как постоянно будет находидить искомые слова.
А в данном данном коде если слов больше чем строк то красятся не все слова.

Вот результат.
Как поставить условия что бы красислись все слова?

procedure TForm1.Button6Click(Sender: TObject);
var Spos,i,n,p,g:integer;
Ser:string;
begin
Spos:=0;
i := Length(RichEdit1.Text);
Label1.Caption := inttostr(i);
RichEdit1.SelStart:=Spos;
n := Pos(AnsiLowerCase(Edit1.Text), AnsiLowerCase(copy(RichEdit1.Lines.Text, Spos+1, length(Richedit1.Lines.Text))))+Spos-1;
Label3.Caption := inttostr(n);
p:=0;
for g:=0  to RichEdit1.Lines.Count - 1 do
  begin
    Label4.Caption := ''+inttostr(n);
    if n > 0
    then begin
    richEdit1.SelStart := n;
    Label1.Caption := 'Текст найден'+inttostr(richEdit1.SelStart);
    n := Pos(AnsiLowerCase(Edit1.Text), AnsiLowerCase(copy(RichEdit1.Lines.Text, Spos+1, length(Richedit1.Lines.Text))))+Spos-1;
    Spos := RichEdit1.SelStart+RichEdit1.SelLength+1;
    RichEdit1.SelLength:=Length(Edit1.Text);
    RichEdit1.SelAttributes.Color := 808080;
    Label2.Caption := inttostr(n);
end
else Label1.Caption := 'Текст ненайден';
Label1.Caption := inttostr(Spos);
end;

end;

я конечно немного закосячил, т.к набрал прямо здесь код, пот сейчас поправил

SelIdx:= 0;
search:= edt.Text;
l:= Length(search);
for i:= 0 to Rich.Lines.Count - 1 do
begin
  s:= Rich.Lines[i];
  p:= Pos(AnsiUpperCase(search), AnsiUpperCase(s));
  while p > 0 do
  begin

    Inc(SelIdx, p); 

    if p > 0 then
    begin
      Rich.SelStart:= SelIdx - l;
      Rich.SelLength:=l;
      Rich.SelAttributes.Color := clRed;
    end;
    
    Delete(s, 1, p + l - 1);
    p:= Pos(AnsiUpperCase(search), AnsiUpperCase(s));
  end;
  Inc(SelIdx, Length(s) + 2);
end;

Есть очень удобная функция PosEx в модуле StrUtils (то есть его надо будет в uses добавить). Она отличается только тем, что третьим параметром (необязательным) имеет смещение от начала строки, в которой надо искать. С ней получается "веселее" (имхо). Вот, что у меня получилось:

procedure TForm1.Button3Click(Sender: TObject);
var
 Spos,n,i: integer;
 s: string;
begin
 Spos:=0;
 i:=length(edit1.Text);
 s:=AnsiLowerCase(RichEdit1.Lines.Text);
 n:=Pos(AnsiLowerCase(Edit1.Text),s);
 if n=0 then begin
   Label1.Caption := 'Текст не найден'+inttostr(richEdit1.SelStart);
   exit;
 end;
 while (n>0) do begin
   RichEdit1.SelStart:=n-1;
   RichEdit1.SelLength:=i;
   RichEdit1.SelAttributes.Color:=$0000FF;
   Spos:=RichEdit1.SelStart+i+1;
   n:=PosEx(AnsiLowerCase(Edit1.Text),s,Spos);
 end;
end;

у меня, в Delphi 5, такого модуля нет....

Да, тут облом. Я на 7-ке писал, а пятого под рукой нет. Может эта функция таки-есть где в другом модуле?
В крайнем случае можно попробовать сам модуль взять. А вообще, для интереса, я из исходников ее выдеру:

function PosEx(const SubStr, S: string; Offset: Cardinal = 1): Integer;
var
  I,X: Integer;
  Len, LenSubStr: Integer;
begin
  if Offset = 1 then
    Result := Pos(SubStr, S)
  else
  begin
    I := Offset;
    LenSubStr := Length(SubStr);
    Len := Length(S) - LenSubStr + 1;
    while I <= Len do
    begin
      if S[I] = SubStr[1] then
      begin
        X := 1;
        while (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) do
          Inc(X);
        if (X = LenSubStr) then
        begin
          Result := I;
          exit;
        end;
      end;
      Inc(I);
    end;
    Result := 0;
  end;
end;

Одно два слова она ищет нормально. А вот больше уже глючит с выделением. У меня кстати тоже фигня в моей функции. Незнаю где ошибка.



P.S.Всем спасибо за помошь и советы))

While not Dm2.AdoTable2.Eof do
begin

RichEdit1.SelStart:=Spos;
n := Pos(AnsiLowerCase(DBEdit3.Text), AnsiLowerCase(copy(RichEdit1.Lines.Text, Spos+1, length(RichEdit1.Lines.Text))))+Spos-1;
if n > 0 then listbox1.Items.Add(DBEdit3.Text);
i:=RichEdit1.Lines.Count;

  for g:=0  to RichEdit1.Lines.Count + 10 do
  begin
    if n > 0
      then begin

      richEdit1.SelStart := n;
      n := Pos(AnsiLowerCase(DBEdit3.Text), AnsiLowerCase(copy(RichEdit1.Lines.Text, Spos+1, length(Richedit1.Lines.Text))))+Spos-1;
      Spos := RichEdit1.SelStart+RichEdit1.SelLength+1;
      RichEdit1.SelLength:=Length(DBEdit3.Text);

end;
Dm2.ADOTable2.Next;
end;

Например есть искать в программном коде слова cin. То выдаст такой результат


class KRUG{public:void ras(){int r;cin>>r;cout<<3.14*r*r;};};
class PR{public:void ras1(){int x,y;cin>>x>>y;cout<<x*y;};};
class TR{public:void ras2(){int a,b,c;cin>>a>>b>>c;cout<<a*b*c;};};
void main(){
cout<<"Plosh'ad' kruga 1\n";
cout<<"pl-d' pryam. 2\n";
cout<<"pl-d' treug. 3\n";
int i;cin>>i;
if (i==1) {KRUG g;g.ras();}
if (i==2) {PR g;g.ras1();}
if (i==3) {TR g;g.ras2();}
getch();

А все понятно. в Рич Едите стояло WordWrap true;))