Функиця поиска слова в файле

  • Автор темы Kai
  • Дата начала
Статус
Закрыто для дальнейших ответов.
K
#1
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 иногда ищет не те слова. Что делать?
 
D

DIR3ct0r

#2
Код:
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;
что то типа такого
 
N

niello

#3
Не пробовал в Делфи, но на С мы и правда сначала все придложение разбивали на слова с пмощюь другой строки:
Код:
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 ...
Или я ошибаюсь?
Хотя у меня возникает другой вопрос, а как тута с буквами большими и маленькими, они же отличаются?
 
D

DIR3ct0r

#4
можно всетаки написать if str1=str2 then ...
Или я ошибаюсь?
все так.....
Хотя у меня возникает другой вопрос, а как тута с буквами большими и маленькими, они же отличаются?
есть функции преобразования строк к верхнему/нижнему регистру, в Си есть функции сравнения, с параметром, исключающим регистр.
 
K
#5
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;
 
D

DIR3ct0r

#6
я конечно немного закосячил, т.к набрал прямо здесь код, пот сейчас поправил
Код:
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;
 
A

Andromeda

#7
Есть очень удобная функция 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;
 
A

Andromeda

#9
Да, тут облом. Я на 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;
 
K
#10
<!--QuoteBegin-Andromeda+21:05:2007, 15:44 -->
<span class="vbquote">(Andromeda @ 21:05:2007, 15:44 )</span><!--QuoteEBegin-->Есть очень удобная функция PosEx в модуле StrUtils (то есть его надо будет в uses добавить). Она отличается только тем, что третьим параметром (необязательным) имеет смещение от начала строки, в которой надо искать. С ней получается "веселее" (имхо). Вот, что у меня получилось:
[snapback]66572" rel="nofollow" target="_blank[/snapback]​
[/quote]


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



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();
 
Статус
Закрыто для дальнейших ответов.