delphi - TWeb浏览器 : Zoom + "one window mode" incompatible

Question

我正在尝试:

我需要一个始终放大(~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 之前和之后单击该链接。缩放后失败。

Answer 1

您可以在 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;