procedure TForm1.SetFocusToDoc;
begin
if WebBrowser1.Document <> nil then
with WebBrowser1.Application as Ioleobject do
DoVerb(OLEIVERB_UIACTIVATE, nil, WebBrowser1, 0, Handle, GetClientRect);
end;
除此之外,我还找到一种更简单的方法,这里一并列出:
if WebBrowser1.Document <> nil then
IHTMLWindow2(IHTMLDocument2(WebBrowser1.Document).ParentWindow).focus
刚找到了更简单的方法,也许是最简单的:
if WebBrowser1.Document <> nil then
IHTMLWindow4(WebBrowser1.Document).focus
还有,需要判断文档是否获得焦点这样来做:
if IHTMLWindow4(WebBrowser1.Document).hasfocus then
Procedure TForm1.ApplicationEvents1Message(var Msg: TMsg; var Handled: Boolean);
{fixes the malfunction of some keys within webbrowser control}
const
StdKeys = [VK_TAB, VK_RETURN]; { standard keys }
ExtKeys = [VK_DELETE, VK_BACK, VK_LEFT, VK_RIGHT]; { extended keys }
fExtended = $01000000; { extended key flag }
begin
Handled := False;
with Msg do
if ((Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST)) and
((wParam in StdKeys) or
{$IFDEF VER120}(GetKeyState(VK_CONTROL) < 0) or {$ENDIF}
(wParam in ExtKeys) and
((lParam and fExtended) = fExtended)) then
try
if IsChild(Handle, hWnd) then { handles all browser related messages }
begin
with {$IFDEF VER120}Application_{$ELSE}Application{$ENDIF} as
IOleInPlaceActiveObject do
Handled := TranslateAccelerator(Msg) = S_OK;
if not Handled then
begin
Handled := True;
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
except
end;
end; // MessageHandler
Var
Doc: IHtmlDocument2;
TxtRange: IHtmlTxtRange;
begin
Doc :=WebBrowser1.Document as IHtmlDocument2;
Doc.SelectAll; //此处为简写,选择全部文档的方法请参见第三条命令操作
//这句话尤为重要,因为IHtmlTxtRange对象的方法能够操作的前提是
//Document已经有一个文字选择区域。由于接着执行下面的语句,所以不会
//看到文档全选的过程。
TxtRange :=Doc.Selection.CreateRange as IHtmlTxtRange;
TxtRange.FindText('Text to be searched',0.0);
TxtRange.Select;
end;
Var
doc:IHTMLDocument2;
all:IHTMLElementCollection;
len,I:integer;
item:OleVariant;
begin
doc:=WebBrowser1 .Document as IHTMLDocument2;
all:=doc.Get_links; //doc.Links亦可
len:=all.length;
for I:=0 to len-1 do begin
item:=all.item(I,varempty); //EmpryParam亦可
memo1.lines.add(item.href);
end;
end;
打印、打印预览和页面设置: 调用“打印”、“打印预览”和“页面设置”对话框(IE5.5及以上版本才支持打印预览,故实现应该检查此命令是否可用)。
ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT, EmptyParam,
EmptyParam);
if QueryStatusWB(OLECMDID_PRINTPREVIEW)=3 then
ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT,
EmptyParam,EmptyParam);
ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_DODEFAULT, EmptyParam,
EmptyParam);
剪切、复制、粘贴、全选: 功能无须多说,需要注意的是:剪切和粘贴不仅对编辑框文字,而且对网页上的非编辑框文字同样有效,用得好的话,也许可以做出功能特殊的东东。获得其命令使能状态和执行命令的方法有两种(以复制为例,剪切、粘贴和全选分别将各自的关键字替换即可,分别为CUT,PASTE和SELECTALL):
A、用TWebBrowser的QueryStatusWB方法。
If(QueryStatusWB(OLECMDID_COPY)=OLECMDF_ENABLED) or
OLECMDF_SUPPORTED) then
ExecWB(OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT, EmptyParam,
EmptyParam);
B、用IHTMLDocument2的QueryCommandEnabled方法。
Var
Doc: IHTMLDocument2;
begin
Doc :=WebBrowser1.Document as IHTMLDocument2;
if Doc.QueryCommandEnabled('Copy') then
Doc.ExecCommand('Copy',false,EmptyParam);
end;
var
p:procedure(Handle: Thandle; Path: Pchar); stdcall;
procedure TForm1.OrganizeFavorite(Sender: Tobject);
var
H: HWnd;
begin
H := LoadLibrary(Pchar('shdocvw.dll'));
if H <> 0 then
begin
p := GetProcAddress(H, Pchar('DoOrganizeFavDlg'));
if Assigned(p) then p(Application.Handle, Pchar(FavFolder));
end;
FreeLibrary(h);
end;
procedure TForm1.AddFavorite(Sender: Tobject);
var
ShellUIHelper: ISHellUIHelper;
url, title: Olevariant;
begin
Title := Webbrowser1.LocationName;
Url := Webbrowser1.LocationUrl;
if Url <> ' then
begin
ShellUIHelper := CreateComObject(CLSID_SHELLUIHELPER) as IShellUIHelper;
ShellUIHelper.AddFavorite(url, title);
end;
end;