6

What I'm trying:

I need a TWebBrowser which is always zoomed in (~140%) AND keeps all links in the same webbrowser (ie. _BLANK links should be opened in the same browser control).

How I'm doing that:

I have set the FEATURE_BROWSER_EMULATION in registry to 9999, so the webpages are rendered with IE9. I have confirmed that this is working. Furthermore, I'm running the compiled program on a fresh install of Windows 7 with IE9, fully updated through Windows Update.

Zoom:

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 perfectly.

Open new windows in the same browser control:

By default, TWebBrowser opens a new IE, when it encounters a link set to be opened in a new window. I need it to stay in my program/webbrowser.

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 cancel the new window, and instead just navigate to the same URL.

Other sources on various pages on the Internet suggests that I don't cancel and instead set ppDisp to various things such as WebBrowser1.DefaultDispath or WebBrowser1.Application and variations of them. This does not work for me. When I click a _BLANK link, nothing happens. This is tested on two computers (both Win7 and IE9). I don't know why it doesn't work, because this seems to be working for other people on the Internet. Maybe this will solve the problem?

Now the problem:

When I combine these 2 pieces of 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 clicking a link (no matter if it is normal or _BLANK) in the webbrowser at runtime, it produces this error:

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

If I remove either part of the code, it works (without the removed code, obviously).

Can anybody help me get both things working at the same time?

Thanks for your time!

Update:

This is now a matter of correctly trapping the new window and keep it in the same browser control. The zooming code in OnDocumentComplete has, as far as I can tell, nothing to do with it. It's the zoom in general. If the WebBrowser control has been zoomed (once is enough), the code in NewWindow3 will fail with "Unspecified error". Resetting the zoom level to 100% doesn't help.

By using the zoom code (ExecWB) something changes "forever" in the WebBrowser, which makes it incompatible with the code in NewWindow3.

Can anybody figure it 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 zooming it fails.

7
  • 2
    I see a few problems: you need to create new webbrowser instances for each popup (think about tabbed browsing). The main problem is that OnDocumentcomplete event can fire multiple times (for example when the page has frames), so it can't do execwb because it's still busy. Commented Jun 27, 2012 at 11:19
  • Do I need to create a new instance? Can't I reuse the same? Commented Jun 27, 2012 at 11:47
  • You can but why would you? One thing that is puzzling me, is this a normal TWebbrowser you are using, I checked in XE and I don't have the NewWindow3 event?? Commented Jun 28, 2012 at 6:36
  • I'm programming for a kiosk PC, which needs to display a handful of different websites. It just makes the most sense to me, to keep everything in a single instance. Regarding the events, I have 2 different: WebBrowser1NewWindow2(ASender: TObject; var ppDisp: IDispatch; var Cancel: WordBool); and WebBrowser1NewWindow3(ASender: TObject; var ppDisp: IDispatch; var Cancel: WordBool; dwFlags: Cardinal; const bstrUrlContext, bstrUrl: WideString); I use the NewWindow3 because it gives me the URL. Does any of your NewWindow events give you the URL? Commented Jun 28, 2012 at 7:12
  • Are you really using TWebbrowser (internet tab)? As I said, I don't have the OnNewWindow3 event and I use a higher version than yours... Commented Jun 28, 2012 at 7:24

2 Answers 2

4

You can set ppDisp to a new instance of IWebBrowser2 in the OnNewWindow2 event e.g:

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; 

It is also suggested by Microsoft to set RegisterAsBrowser to true.
You could change this code to open a TWebBrowser in a new tab inside a Page control.

We can not set ppDisp to the current instance of the TWebBrowser - so using this simple code:

ppDisp := WebBrowser1.DefaultDispatch; dose not work.

We need to "recreate" the current/active TWebBrowser, if we want to maintain the UI flow - note that in the following example the TWebBrowser is created on the fly e.g.:

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; 
Sign up to request clarification or add additional context in comments.

7 Comments

Thanks. I am beginning to think that I, as you suggest, need to destroy the current TWebBrowser and create a new one. It just seems like an unnecessary extra step, but it seems that the webbrowser is designed to be used this way?
Seems so... I also agree that it's kinda messy to create a new instance and destroy the old one, but it's the only way I could make it work if I wanted to "re-use" the "active" WebBrowser and keep the UI flow.
That seems to work! Thanks! How do I access this new webbrowser from code? Can I give it a name during creation, and then use FindComponent to find it at runtime?
Yes, you could do that. or better hold a local private variable, or even better, create the main TWebBrowser dynamically (on form create), and reuse it.
@Michael, I have edited my answer to demonstrate how to use a dynamic TWebBrowser.
|
2

I think the problem is that sometimes OnDocumentComplete can fire multiple times on document load (pages with frames).

Here is the way to implement it properly.

1 Comment

Thanks, I will definitely use that code! It seems more safe. But it still gives "unspecified error" for _BLANK links.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.