TWebBrowser：缩放+“单窗口模式”不兼容

Question

我正在尝试什么：

我需要一个 TWebBrowser，它总是放大 (~140%) 并将所有链接保存在同一个 webbrowser 中（即 _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。

Internet 上各种页面上的其他来源建议我不要取消，而是将 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 之前和之后单击链接。缩放后失败。

Answer 1

您可以在OnNewWindow2 事件中将ppDisp 设置为IWebBrowser2 的新 实例，例如：

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;

将RegisterAsBrowser设置为true也是suggested by Microsoft。
您可以更改此代码以在 Page 控件内的新选项卡中打开 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;

Answer 2

我认为问题在于有时 OnDocumentComplete 会在文档加载时触发多次（带有框架的页面）。

Here is the way to implement it properly.