点击TWebBrowser中的超级链接不在新的IE窗口打开

如果是用新窗体打开,而不是用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.

你可能感兴趣的:(WebBrowser)