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

 

如果是用新窗体打开，而不是用IE打开，简单一点：（From MSDN）

view source

print ?

01	procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;

02	var ppDisp: IDispatch; var Cancel: WordBool);

03

var

04	frmWB:TForm1;

05

begin

06	frmWB := TForm1.Create(Application);//注意，这里Self和Application、nil结果不同...

07

08	frmWB.WebBrowser1.RegisterAsBrowser := TRUE;

09	ppDisp := frmWB.WebBrowser1.OleObject;

10	frmWB.Visible := TRUE;

11

end;

如果是用当前WebBrowser打开，可以这样：（为描述清楚，列出了我的整个单元）

view source

print ?

01	unit Unit1;

02

03

interface

04

05

uses

06	Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

07	Dialogs, OleCtrls, SHDocVw, StdCtrls;

08

09

type

10

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);

11	private     { Private declarations }

12	public     { Public declarations }

13

end;

14

15

var

16	Form1: TForm1;

17

18	implementation

19

20	{$R *.dfm}

21

var

22	tempWB : TWebBrowser;//临时TWeb

23

24	procedure TForm1.Button1Click(Sender: TObject);

25

begin

26	Self.WebBrowser1.Navigate('http://news.baidu.com);//这个没话可说，访问默认页面，随便点击一个新闻即可出发新窗口浏览事件：NewWindow2

27

end;

28

29	procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;

30	var ppDisp: IDispatch; var Cancel: WordBool);

31

begin

32	if not Assigned(tempWB) then tempWB := TWebBrowser.Create(Self);

33	tempWB.OnBeforeNavigate2 := Self.tempWBBeforeNavigate2;

34	ppDisp := tempWB.OleObject;

35

end;

36

37	procedure TForm1.tempWBBeforeNavigate2(Sender: TObject;//自定义新窗口弹出前的代码

38	const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,

39	Headers: OleVariant; var Cancel: WordBool);

40

begin

41	Self.WebBrowser1.Navigate(Url);

42	Cancel := True;

43

end;

44

45	procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;

46	const pDisp: IDispatch; var URL: OleVariant);

47

begin

48	if Assigned(tempWB) then FreeAndNil(tempWB);

49

end;

50

51

end.

 

转载于:https://www.cnblogs.com/hssbsw/archive/2011/05/07/2039705.html