TWebBrowser: Zoom + "single window mode" is incompatible

Question

What am I trying:

I need a TWebBrowser that always grows (~ 140%) and saves all the links in the same web browser (i.e. _BLANK links should be open in the same browser).

How do i do this:

I set FEATURE_BROWSER_EMULATION in the registry in 9999, so the web pages are displayed in IE9. I confirmed that this works. In addition, I run the compiled program on a new installation of Windows 7 with IE9, fully updated through Windows Update.

Click to enlarge

 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; 

This works great.

Open new windows in the same browser:

By default, TWebBrowser opens a new IE when it encounters a set of links that will open in a new window. I need it to stay in my program / web browser.

I have tried many things here. This works for me:

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

I undo the new window and go to the same URL instead.

Other sources on different pages on the Internet say that I do not cancel and instead install ppDisp on various things, such as WebBrowser1.DefaultDispath or WebBrowser1.Application and their variants. This does not work for me. When I click the _BLANK link, nothing happens. This is tested on two computers (both Win7 and IE9). I do not know why this does not work, because it seems to work for other people on the Internet. Maybe this will solve the problem?

Now the problem is:

When I combine these 2 parts of the code, it breaks!

 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; 

When you click on a link (regardless of its normal or _BLANK) in a web browser, the following error occurs at runtime:

 First chance exception at $75F1B9BC. Exception class EOleException with message 'Unspecified error'. Process Project1.exe (3288) 

If I delete any part of the code, it works (without the removed code, obviously).

Can someone help me make both things work at the same time?

Thank you for your time!

Update:

Now it is a matter of correctly catching a new window and saving it in the same browser. The scaling code in OnDocumentComplete, as far as I can tell, has nothing to do with it. This is the zoom in general. If the WebBrowser control has been enlarged (once enough), the code in NewWindow3 will fail with a "Unspecified" error. Resetting the zoom level to 100% does not help.

Using the scaling code (ExecWB) in WebBrowser, something changes "forever", which makes it incompatible with the code in NewWindow3.

Can anyone figure this out?

New code:

 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; 

Try clicking the link both before and after clicking Button1. After scaling, it does not work.

Answer 1

You can install ppDisp in a new instance of IWebBrowser2 in the OnNewWindow2 event, for example:

 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; 

Also suggested by Microsoft , set RegisterAsBrowser to true .
You can modify this code to open TWebBrowser in a new tab inside the page control.

We cannot install ppDisp in the current instance of TWebBrowser - therefore, using this simple code:

ppDisp := WebBrowser1.DefaultDispatch; the dose does not work.

We need to "recreate" the current / active TWebBrowser if we want to support the user interface stream. Note that the following TWebBrowser example is created on the fly, for example:

 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

I think the problem is that OnDocumentComplete can sometimes start loading a document (pages with frames) multiple times.

Here's how to implement it correctly.