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

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

1
2
3
4
5
6
7
8
9
10
11
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打开，可以这样：（为描述清楚，列出了我的整个单元）

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
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.
posted @ 2013-12-29 16:16  孤舟残月浅笑嫣然  阅读(227)  评论(0)  编辑  收藏  举报