Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: ActiveX/СОМ/CORBA > TWebBrowser, поиск текста

Автор: RaIDeR 13.7.2005, 13:54

Здравствуйте все ! Я нашел хороший код поиска текста в докементе загруженном
в браузер, вот собственно сам код:

Код


procedure TForm1.Button1Click(Sender: TObject);
var
  Doc, Txt: Variant;
begin
  if edit1.Text = '' then Exit;
  Doc := Browser.Document;
  Txt := Doc.Body.CreateTextRange;
  if not Txt.FindText(edit1.Text) then Exit;
  while edit1.Text > '' do
  begin
    Txt.FindText(edit1.Text);
    Txt.ExecCommand('BackColor', '', 'yellow');
    Txt.ExecCommand('ForeColor', '', 'red');
    Txt.ExecCommand('Bold');
    Txt.ScrollInToView;
    Txt.Collapse(false);
    if not Txt.FindText(edit1.Text) then Break;
  end;
end;

Всё бы хорошо, но данный код находит и выделяет весь текст найденый
в документе, а как сделать типа "Найти вперед" и "Найти назад" ?
И снять старое выделение ?

Автор: _hunter 13.7.2005, 14:22

как искать вперед/назад:

Цитата

bFound = TextRange.findText(sText [, iSearchScope] [, iFlags])
Parameters

sText Required. String that specifies the text to find.
iSearchScope Optional. Integer that specifies the number of characters to search from the starting point of the range. A positive integer indicates a forward search; a negative integer indicates a backward search.
iFlags Optional. Integer that specifies one or more of the following flags to indicate the type of search: 0 Default. Match partial words.
1 Match backwards.
2 Match whole words only.
4 Match case.
131072 Match bytes.
536870912 Match diacritical marks.
1073741824 Match Kashida character.
2147483648 Match AlefHamza character.

как снять старое выделение: перед закрашиванием запомни цвета и перед новым поиском закрасть текст этими цветами

Автор: RaIDeR 13.7.2005, 15:51

Своими знания англ. вот как я это перевёл:

Цитата

sText - Строка которую нужно найти.
iSearchScope - Целое число определяющее кол-во символов для поиска с диапозона стартовой точки,
положительное число указывает на поиск вперёд, отрицательное - назад.
iFlags - Целое число которое определяет одно или более кол-во флагов для того чтобы указать тип поиска.
Параметры iFlags:
0 - По умолчанию/Соответствующее части слова
1 - Задом наперед.
2 - Только целое слово ???
4 - Соответсвующее регистру ???
131072 - ???
536870912 - ???
1073741824 - ???
2147483648 - ???

Приведи ПОЖАЛУЙСТА пример поиска, а то здаётся мне я всё не так понял smile

И покажи как нужно сохранять цвет. smile

Автор: December 13.7.2005, 18:30

Цитата(_hunter @ 13.7.2005, 14:22)

1 Match backwards.

1 Искать назад

Автор: RaIDeR 14.7.2005, 16:43

Помогите разобраться ! smile

Я в этом ничё понять не могу smile

Исходя из выше показанного:

Цитата

TextRange.findText(sText [, iSearchScope] [, iFlags])

Получается примерно такой запрос:

Код


procedure TForm1.Button2Click(Sender: TObject);
var
  Doc, Txt: Variant;
begin
Doc := Browser.Document;
Txt := Doc.Body.CreateTextRange;

Txt.FindText(edit1.Text, Legnth(edit1.Text), 0); // <<--- Вот он :)

В итоге получается полная фигня ... smile

Автор: RaIDeR 15.7.2005, 10:59

Вот какой ёще я нашёл код:

Код

 
procedure TForm1.edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  Txt: IHTMLTxtRange; // Выжный момент, вместо Variаnt --> IHTMLTxtRange
begin
if key = VK_RETURN then
begin

  if edit1.Text = '' then Exit;

  Txt := ((WebBrowser1.Document as IHTMLDocument2).body as IHTMLBodyElement).createTextRange;

  Txt.findText(edit1.Text, Length(edit1.Text), 0); // <-- Вот сам поиск
  Txt.pasteHTML('<span style="background-color: Lime; font-weight: bolder;">' + Txt.htmlText + '</span>');  //Set the highlight, now background color will be Lime
  Txt.scrollIntoView(True);

end;
end;

Этот код вроде правельный, ищет вперед и назад, но как сделать поск пошагово ?
Т.е чтоб он продолжался с той позиции на которой он остановился при последнем
поиске ? Помогите плиз smile

Автор: RaIDeR 15.7.2005, 13:21

Ура !!! Я понял как сохранять позицию smile

У IHTMLTxtRange есть
св-во text - вот его то как раз нудо запоминать, вот код:

Код


uses MSHTML;
...
private
  SourceText: WideString; // Сюда я сохраняю text
  TextRange: IHTMLTxtRange; // Сам диапозон
...

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BrowserNavigateComplete2(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
SourceText := ''; 
TextRange := ((Browser.Document as IHTMLDocument2).body as IHTMLBodyElement).createTextRange;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin

  if edit1.Text = '' then Exit;

  if SourceText <> '' then TextRange.text := SourceText; // Восстанавливаем позицию

  TextRange.findText(edit1.Text, 1, 0); // Ищем текст
  SourceText := TextRange.text; // Запоминаем позицию
  TextRange.select;  // Выделяем текст
  TextRange.scrollIntoView(True);

end;

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

Цитата

1 Match backwards.

Не работает smile

Автор: RaIDeR 18.7.2005, 18:56

Хе Хе Хе, Я сделал ЭТО smile

Вот какую процедуру Я накатал:

Код


procedure WBFindText(Browser: TWebBrowser; const Direction: Boolean; const FText: String;
  const SearchScope, Flags: Integer);
var
  Doc: IHTMLDocument2;
  SelObj: IHTMLSelectionObject;
  SelRange: IHtmlTxtRange;
begin

  Doc := Browser.Document as IHTMLDocument2;
  SelObj := Doc.Selection;
  SelRange := SelObj.CreateRange as IHTMLTxtRange;

  SelRange.Collapse(Direction);

  if SelRange.FindText(FText, SearchScope, Flags) then
  begin
    SelRange.Select;
    SelRange.ScrollIntoView(True);
  end
    else MessageBox(Handle, 'По Вашему запросу ничего не найдено', 'Поиск текста', MB_ICONINFORMATION);

end;

Использование:

WBFindText(MyCoolBrowser, False, 'MyCoolText', 1, 0); // Найти вперед

WBFindText(MyCoolBrowser, False, 'MyCoolText', 1, 0 or 4); // Найти вперед + чуствительность к регистру

WBFindText(MyCoolBrowser, True, 'MyCoolText', - 1, 1); // Найти назад

WBFindText(MyCoolBrowser, True, 'MyCoolText', - 1, 1 or 4); // Найти назад + чуствительность к регистру