Question

我在尝试什么：

我需要一个总是放大的TWebBrowser（~140％）并将所有链接保存在同一个web浏览器中（即_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。我需要它留在我的程序/ webbrowser。

我在这里尝试过很多东西。这对我有用：

procedure TFormWeb.WebBrowser1NewWindow3(ASender: TObject;
  var ppDisp: IDispatch; var Cancel: WordBool; dwFlags: Cardinal;
  const bstrUrlContext, bstrUrl: WideString);
begin
  Cancel := True;
  WebBrowser1.Navigate(bstrUrl);
end;

我取消了新窗口，而只是导航到同一个网址。

互联网上各个页面上的其他来源表明我不会取消，而是将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;

在运行时单击webbrowser中的链接（无论是正常链接还是_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

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

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;无效。

如果我们想维护用户界面流量，我们需要“重新创建”当前/有效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.

TWebBrowser：缩放+＆＃34;一种窗口模式＆＃34;不相容

我在尝试什么：

我是怎么做到的：

现在问题是：

更新

2 个答案: