如果是用新窗体打开,而不是用IE打开,简单一点:(From MSDN)
procedure TForm1.WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool); var frmWB:TForm1; begin frmWB := TForm1.Create(Application);//注意,这里Self和Application、nil结果不同... frmWB.WebBrowser1.RegisterAsBrowser := TRUE; ppDisp := frmWB.WebBrowser1.OleObject; frmWB.Visible := TRUE; end;
如果是用当前WebBrowser打开,可以这样:(为描述清楚,列出了我的整个单元)
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, OleCtrls, SHDocVw, StdCtrls; type TForm1 = class(TForm) Button1: TButton; WebBrowser1: TWebBrowser; procedure Button1Click(Sender: TObject); procedure WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool); procedure tempWBBeforeNavigate2(Sender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool); procedure WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} var tempWB : TWebBrowser;//临时TWeb procedure TForm1.Button1Click(Sender: TObject); begin Self.WebBrowser1.Navigate('http://news.baidu.com);//这个没话可说,访问默认页面,随便点击一个新闻即可出发新窗口浏览事件:NewWindow2 end; procedure TForm1.WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool); begin if not Assigned(tempWB) then tempWB := TWebBrowser.Create(Self); tempWB.OnBeforeNavigate2 := Self.tempWBBeforeNavigate2; ppDisp := tempWB.OleObject; end; procedure TForm1.tempWBBeforeNavigate2(Sender: TObject;//自定义新窗口弹出前的代码 const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool); begin Self.WebBrowser1.Navigate(Url); Cancel := True; end; procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); begin if Assigned(tempWB) then FreeAndNil(tempWB); end; end.