TWebBrowser: Zoom + "one window mode" incompatible - delphi

Question

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.

Answer 1

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;

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