zoukankan      html  css  js  c++  java
  • 点击TWebBrowser中的超级链接不在新的IE窗口打开

    如果是用新窗体打开,而不是用IE打开,简单一点:(From MSDN)

    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打开,可以这样:(为描述清楚,列出了我的整个单元)

    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.
  • 相关阅读:
    Js五子棋游戏
    换肤
    jqzoom实战
    iphone开发笔记
    腾讯召实习生笔试题
    ajax( 汇率转化)
    20140805 17:24
    加载上一级目录下的图片文件并得到加载图片的大小
    精确碰撞检测 bitmapData.hitTest
    buttonMode 与mouseChildren【替换鼠标之后不响应鼠标事件】
  • 原文地址:https://www.cnblogs.com/hssbsw/p/2039705.html
Copyright © 2011-2022 走看看