我正在尝试:
我需要一个始终放大(~140%)的 TWebBrowser,并将所有链接保留在同一网络浏览器中(即。_BLANK 链接应在同一浏览器控件中打开)。
我是如何做到的:
我已将注册表中的FEATURE_BROWSER_EMULATION
设置为9999,因此网页将使用IE9呈现。我已经确认这是有效的。此外,我正在全新安装的带有 IE9 的 Windows 7 上运行编译后的程序,并通过 Windows Update 进行了全面更新。
缩放:
procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
ZoomFac: OLEVariant;
begin
ZoomFac := 140;
WebBrowser1.ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, ZoomFac);
end;
这非常有效。
在同一浏览器控件中打开新窗口:
默认情况下,TWebBrowser 在遇到设置为在新窗口中打开的链接时会打开一个新的 IE。我需要它保留在我的程序/网络浏览器中。
我在这里尝试了很多东西。这对我有用:
procedure TFormWeb.WebBrowser1NewWindow3(ASender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool; dwFlags: Cardinal;
const bstrUrlContext, bstrUrl: WideString);
begin
Cancel := True;
WebBrowser1.Navigate(bstrUrl);
end;
我取消了新窗口,而是导航到相同的 URL。
互联网上各个页面上的其他来源建议我不要取消,而是将 ppDisp 设置为各种内容,例如 WebBrowser1.DefaultDispath
或 WebBrowser1.Application
及其变体其中。这对我不起作用。当我单击 _BLANK 链接时,没有任何反应。这是在两台电脑上测试的(都是Win7和IE9)。我不知道为什么它不起作用,因为这似乎对互联网上的其他人有效。也许这可以解决问题?
现在的问题:
当我组合这两段代码时,它就崩溃了!
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate('http://wbm.dk/test.htm');
// This is a test page, that I created. It just contains a normal link to google.com
end;
procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
ZoomFac: OLEVariant;
begin
ZoomFac := 140;
WebBrowser1.ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, ZoomFac);
end;
procedure TForm1.WebBrowser1NewWindow3(ASender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool; dwFlags: Cardinal; const bstrUrlContext,
bstrUrl: WideString);
begin
Cancel := True;
WebBrowser1.Navigate(bstrUrl);
end;
运行时在网络浏览器中单击链接(无论是正常链接还是_BLANK)时,会产生以下错误:
First chance exception at $75F1B9BC. Exception class EOleException with message 'Unspecified error'. Process Project1.exe (3288)
如果我删除代码的任何一部分,它就会起作用(显然没有删除的代码)。
任何人都可以帮助我让这两件事同时工作吗?
感谢您的宝贵时间!
更新:
现在的问题是正确捕获新窗口并将其保留在同一浏览器控件中。据我所知,OnDocumentComplete 中的缩放代码与此无关。这是一般的变焦。如果 WebBrowser 控件已缩放(一次就足够了),NewWindow3 中的代码将失败并显示“未指定错误”。将缩放级别重置为 100% 没有帮助。
通过使用缩放代码 (ExecWB),WebBrowser 中的某些内容会“永远”发生变化,这使其与 NewWindow3 中的代码不兼容。
有人能猜出来吗?
新代码:
procedure TForm1.Button1Click(Sender: TObject);
var
ZoomFac: OLEVariant;
begin
ZoomFac := 140;
WebBrowser1.ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, ZoomFac);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('http://www.wbm.dk/test.htm');
end;
procedure TForm1.WebBrowser1NewWindow3(ASender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool; dwFlags: Cardinal; const bstrUrlContext,
bstrUrl: WideString);
begin
Cancel := True;
WebBrowser1.Navigate(bstrUrl);
end;
尝试在单击 Button1 之前和之后单击该链接。缩放后失败。
最佳答案
您可以在 OnNewWindow2
事件中将 ppDisp
设置为 IWebBrowser2
的 new 实例,例如:
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate('http://wbm.dk/test.htm');
end;
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
ZoomFac: OleVariant;
begin
// the top-level browser
if pDisp = TWebBrowser(Sender).ControlInterface then
begin
ZoomFac := 140;
TWebBrowser(Sender).ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, ZoomFac);
end;
end;
procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
var
NewWindow: TForm1;
begin
// ppDisp is nil; this will create a new instance of TForm1:
NewWindow := TForm1.Create(self);
NewWindow.Show;
ppDisp := NewWindow.Webbrowser1.DefaultDispatch;
end;
也是 suggested by Microsoft将 RegisterAsBrowser
设置为 true
。
您可以更改此代码以在页面控件内的新选项卡中打开 TWebBrowser
。
我们无法将 ppDisp
设置为 TWebBrowser
的当前实例 - 因此使用以下简单代码:
ppDisp := WebBrowser1.DefaultDispatch;
不起作用。
如果我们想要维护 UI 流程,我们需要“重新创建”当前/事件的 TWebBrowser
- 请注意,在以下示例中 TWebBrowser
是动态创建的,例如:
const
CM_WB_DESTROY = WM_USER + 1;
OLECMDID_OPTICAL_ZOOM = 63;
type
TForm1 = class(TForm)
Button1: TButton;
Panel1: TPanel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
function CreateWebBrowser: TWebBrowser;
procedure WebBrowserDocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant);
procedure WebBrowserNewWindow2(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
procedure CMWebBrowserDestroy(var Message: TMessage); message CM_WB_DESTROY;
public
WebBrowser: TWebBrowser;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser := CreateWebBrowser;
end;
function TForm1.CreateWebBrowser: TWebBrowser;
begin
Result := TWebBrowser.Create(Self);
TWinControl(Result).Parent := Panel1;
Result.Align := alClient;
Result.OnDocumentComplete := WebBrowserDocumentComplete;
Result.OnNewWindow2 := WebBrowserNewWindow2;
Result.RegisterAsBrowser := True;
end;
procedure TForm1.WebBrowserDocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
ZoomFac: OleVariant;
begin
// the top-level browser
if pDisp = TWebBrowser(Sender).ControlInterface then
begin
ZoomFac := 140;
TWebBrowser(Sender).ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, ZoomFac);
end;
end;
procedure TForm1.WebBrowserNewWindow2(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
var
NewWB: TWebBrowser;
begin
NewWB := CreateWebBrowser;
ppDisp := NewWB.DefaultDispatch;
WebBrowser := NewWB;
// just in case...
TWebBrowser(Sender).Stop;
TWebBrowser(Sender).OnDocumentComplete := nil;
TWebBrowser(Sender).OnNewWindow2 := nil;
// post a delayed message to destory the current TWebBrowser
PostMessage(Self.Handle, CM_WB_DESTROY, Integer(TWebBrowser(Sender)), 0);
end;
procedure TForm1.CMWebBrowserDestroy(var Message: TMessage);
var
Sender: TObject;
begin
Sender := TObject(Message.WParam);
if Assigned(Sender) and (Sender is TWebBrowser) then
TWebBrowser(Sender).Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser.Navigate('http://wbm.dk/test.htm');
end;
关于delphi - TWeb浏览器 : Zoom + "one window mode" incompatible,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/11223197/