Delphi使用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;



procedure TForm1.Button1Click(Sender: TObject);

begin

  Self.WebBrowser1.Navigate('http://www.google.com.hk');

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.