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.

TLama
  • 75,147
  • 17
  • 214
  • 392
Michael
  • 125
  • 1
  • 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. – whosrdaddy Jun 27 '12 at 11:19
  • Do I need to create a new instance? Can't I reuse the same? – Michael Jun 27 '12 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?? – whosrdaddy Jun 28 '12 at 06: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? – Michael Jun 28 '12 at 07: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... – whosrdaddy Jun 28 '12 at 07:24
  • I installed it from "Import ActiveX control", and then "Microsoft Internet Controls". That registered the TWebBrowser in the Internet tab. Maybe it's not the same as the one installed by default in some Delphi installations? – Michael Jun 28 '12 at 07:35
  • Aah, now I see. Ok will do the same and see if I can reproduce your problem... – whosrdaddy Jun 28 '12 at 08:18

2 Answers2

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;
kobik
  • 21,001
  • 4
  • 61
  • 121
  • 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? – Michael Jun 28 '12 at 09:30
  • 1
    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. – kobik Jun 28 '12 at 10:27
  • 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? – Michael Jun 28 '12 at 11:01
  • 1
    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. – kobik Jun 28 '12 at 11:09
  • I'm trying to create it dynamically at runtime now. Are you saying that I can reuse the same TWebBrowser again and again (by freeing it and creating it again), or do I have to alternate between 2? – Michael Jun 28 '12 at 11:49
  • 1
    @Michael, I have edited my answer to demonstrate how to use a dynamic TWebBrowser. – kobik Jun 28 '12 at 13:28
  • Thank you very much for your time! It works! I'm so happy! It does introduce a new problem with the URL history being forgotten (obviously), however, I will likely not need back and forward functionality - otherwise it should be fairly simple to keep track of the history in our own list. But thanks again :) – Michael Jun 28 '12 at 15:22
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.

Community
  • 1
  • 1
whosrdaddy
  • 11,720
  • 4
  • 50
  • 99
  • Thanks, I will definitely use that code! It seems more safe. But it still gives "unspecified error" for _BLANK links. – Michael Jun 27 '12 at 11:44