WebBrowser的两个老问题：查找和加亮(300分)

刚刚没注意，应该是300分

1.WebBrowser的查找功能，要求不出现查找对话框，按序查找所有内容。
我试过：
procedure TForm1.Button3Click(Sender: TObject);
const
CLSID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
var
CmdTarget: IOleCommandTarget;
begin
try
WebBrowser1.Document.QueryInterface(IOleCommandTarget, CmdTarget);
if CmdTarget <> nil then
try
CmdTarget.Exec(@CLSID_WebBrowser, 1, 0, EmptyParam, EmptyParam);
finally
CmdTarget._Release;
end;
except
end;
end;
但这个方法会出现查找对话框。
以及：
procedure TForm1.Button4Click(Sender: TObject);
var
Doc: IHtmlDocument2;
Txt:IHTMLTxtRange;
begin
Doc := WebBrowser1.Document as IHTMLDocument2;
WebBrowser1.ExecWB(OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT,
EmptyParam,EmptyParam);
Txt :=Doc.selection.createRange as IHTMLTxtRange;
Txt.findText('a',0,0);
Txt.select;
end;
这个方法不出现查找对话框，但只能找到第一个。

============================================================================
2.WebBrowser中的加亮功能，即类似CHM文件搜索后出现的那种加亮。
我试过：
procedure TForm1.SearchAndHighlightText(aText: string);
var
i: Integer;
begin
for i := 0 to WebBrowser1.OleObject.Document.All.Length - 1 do
begin
if Pos(aText, WebBrowser1.OleObject.Document.All.Item(i).InnerText) <> 0 then
begin
WebBrowser1.OleObject.Document.All.Item(i).Style.Color := '#FFFF00';
//WebBrowser1.OleObject.Document.All.Item(i).ScrollIntoView(True);
end;
end;
end;
但效果不理想。

请告诉我具体做法，不要只给出个网址，如：http://www.euromind.com/iedelphi/

gz

第二种(中间的)方法应该比较可行！！！！！
这里的主要问题是：要将第一次所查找到的文本后的所有文本进行“选中”。

只要能进行这样的选中就可以.............

to jsxjd:
可是我不会：（，怎样才能改变选择范围呢？

你的这一问题，我已经圆满解决，并调试成功！！！！！！

uses ............,mshtml;


//以下将WebBrowser 中所有文字“工业”的背景设置为黄色
procedure TForm1.Button1Click(Sender: TObject);
var
s,SearchString,colorString:Widestring;
doc:IHTMLdocument2;
e:IHTMLElement;
sel:IHTMLTxtRange;
n,m,len:integer;
begin
try
SearchString:='工业'
//要查找的字符串
colorString:='<font style="background-color:yellow">'+
SearchString+'</font>';
len:=length(SearchString);
doc:=IHTMLdocument2(webbrowser1.Document );
e:=IHTMLElement(doc.body);
s:=e.innerText;

n:=0;
m:=pos(SearchString,s);
while m>0 do
begin
doc.execCommand('SelectAll',true,EmptyParam);
sel:=IHTMLTxtRange(doc.selection.createRange);
sel.moveStart('character',n);
sel.findText(searchString,len,0);
sel.select;
sel:=IHTMLTxtRange(doc.selection.createRange);
inc(n,m+len-1);

sel.pasteHTML(colorString);
s:=copy(s,m+len,length(S)-(m+len)+1);
m:=pos(SearchString,s);
end;
except
end;

end;

可能需要再完善一下！

又完善一下，加了一段。如有问题可再讨论！！

//以下将WebBrowser 中所有文字“工业”的背景设置为黄色
procedure TForm1.Button1Click(Sender: TObject);
var
s,SearchString,colorString:Widestring;
ss:string;
doc:IHTMLdocument2;
e:IHTMLElement;
sel:IHTMLTxtRange;
n,m,len,i:integer;
begin
try
SearchString:='工业'
//要查找的字符串
colorString:='<font style="background-color:yellow">'+
SearchString+'</font>';
len:=length(SearchString);
doc:=IHTMLdocument2(webbrowser1.Document );
e:=IHTMLElement(doc.body);
s:=e.innerText;

///////// 加上以下这一段， #13#10 在WebBrowser是一个字符
//////// 而在Delphi 中是两字符，会引起偏差。
//////// 必须删除一个，都变成一个字符，这样就可以了，
///////// 这个原因是由 <p> 引起的，<br>不会引起这一问题。
ss:=string(s);
while true do begin
n:=pos(#13,ss);
if n>0 then delete(ss,n,1) else break;
end;
///////////////////////////////

s:=widestring(ss);

n:=0;
m:=pos(SearchString,s);

while m>0 do
begin
doc.execCommand('SelectAll',true,EmptyParam);
sel:=IHTMLTxtRange(doc.selection.createRange);

sel.moveStart('character',n-1);

sel.findText(searchString,len,0);
sel.select;
sel:=IHTMLTxtRange(doc.selection.createRange);

inc(n,m+len-1);

sel.pasteHTML(colorString);
s:=copy(s,m+len,length(S)-(m+len)+1);
m:=pos(SearchString,s);
end;
except
end;
end;

：），多谢，给分。
不过不知您有没有用过google toolbar
http://toolbar.google.com/
或“天网搜霸”
http://toolbar.bingle.com.cn/
它们的加亮功能不用先select all，速度很快，不知是怎么做的。如果能做到，我愿意再
出300分。

//给3000元都不过分
//绝对的正宗解决方案，我找不出问题
procedure TForm1.Button1Click(Sender: TObject);
var
sString,bgColor:string;
doc:IHTMLdocument2;
R:IHTMLTxtRange;
begin
sString :='document'
//=Edit1.text
要查找的字符串,空格都能找
//还可以跨边界 比如 <u>docum<b>entdo</b>cument</u>
bgColor :='magenta'
//=Edit2.text
也可以是 #FF00FF FFFF00 这种形式
try
doc :=IHTMLdocument2(webbrowser1.Document)
R :=IHTMLTxtRange(doc.selection.createRange);
while R.findText(sString,1,0) do begin
R.select;
R.execCommand('Backcolor',false,bgColor);
R.setEndPoint('StartToEnd',R);
end;
except
end;
end;