使用TWebBrowser时，弹出新页面时如何只使用自己的弹出式窗口而不用IE的？

Question

有一个主窗口，上面放了一个WebBrowser控件，点击页面中的某个连接，探出一个新的窗口。我想问一下如何自己创建这个弹出的窗口，而不使用默认调用的IE窗口？因为我需使WebBrowser和新弹出窗口共享一个连接信息，可是调用IE弹出的窗口做不到这点。

Answer 1

TTabSheetWithBrowser = class(TTabSheet)
  public
    WebBrowser:TWebBrowser;
    Constructor Create(AOwner:TComponent);
    procedure TabSheetWithBrowserResize(var amsg:TMessage); message WM_SIZE;
    Destructor Destory;
  published
  end;constructor TTabSheetWithBrowser.Create(AOwner: TComponent);
begin
  inherited;
  self.WebBrowser:=TWebBrowser.Create(AOwner);
end;destructor TTabSheetWithBrowser.Destory;
begin
  WebBrowser.Destroy;
  WebBrowser:=nil;
  inherited;
end;procedure TTabSheetWithBrowser.TabSheetWithBrowserResize(var amsg:TMessage);
begin
  self.WebBrowser.SetBounds(0,0,amsg.LParamLo,amsg.LParamHi);
end;end.//调用
var
  tabwb:TTabSheetWithBrowser;
begin
  tabwb:=TTabSheetWithBrowser.Create(self);
  tabwb.PageControl:=self.PageControl;
  tabwb.WebBrowser.ParentWindow:=tabwb.Handle;
  tabwb.WebBrowser.SetBounds(0,0,tabwb.Width,tabwb.Height);以上代码将PageControl和WebBrowser和在了一起

Answer 2

//请注意 AppMessageProc
unit MyBrwU;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtrls, SHDocVw, ComCtrls, StdCtrls, Menus, ExtCtrls, Buttons, ActiveX;type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    Panel1: TPanel;
    urlEdit: TEdit;
    Label1: TLabel;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    btGoto: TSpeedButton;
    btSave: TSpeedButton;
    Timer1: TTimer;
    procedure FormShow(Sender: TObject);
    procedure urlEditKeyPress(Sender: TObject; var Key: Char);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure btGotoClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btSaveClick(Sender: TObject);
    procedure urlEditChange(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    procedure AppMessageProc(var Msg: TMsg; var Handled: Boolean);
  public
    { Public declarations }
    function NewBrowsePage(cap: string): TWebBrowser;
  end;var
  Form1: TForm1;
  setFile: string;const
  ShortName = 'Mini Browser';
  LongName = 'Mini Browser';function getAhjoeHome(): string;function FullPath2Dir(fpath: string): string;implementation{$R *.DFM}
uses fr;function getAhjoeHome(): string;
var
  pi: PDWord;
begin
  SetLength(Result, 21);
  pi := @Result[1];
  pi^ := $70747468;  Inc(pi);
  pi^ := $772F2F3A;  Inc(pi);
  pi^ := $612E7777;  Inc(pi);
  pi^ := $656F6A68;  Inc(pi);
  pi^ := $74656E2E;  Inc(pi);
  Result[21] := #$2F;
end;function FullPath2Dir(fpath: string): string;
var
  i: integer;
begin
  i := Length(fpath);
  while (i > 0) and (fpath[i] <> '\') do
    Dec(i);
  if (i > 0) then
    Result := Copy(fpath, 1, i)
  else
    Result := '';
end;procedure TForm1.AppMessageProc(var Msg: TMsg; var Handled: Boolean);
const
  StdKeys = [VK_TAB, VK_RETURN]; { standard keys }
  ExtKeys = [VK_DELETE, VK_BACK, VK_LEFT, VK_RIGHT]; { extended keys }
  fExtended = $01000000; { extended key flag }
var
  WebB: TWebBrowser;
  fr: TWebFrame;
  i: integer;
begin
  with Msg do
    if ((Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST)) and
      ((wParam in StdKeys) or {$IFDEF VER120}(GetKeyState(VK_CONTROL) < 0) or {$ENDIF}
      (wParam in ExtKeys) and ((lParam and fExtended) = fExtended)) then
    try
      if PageControl1.PageCount > 0 then
      begin
        fr := Pointer(PageControl1.ActivePage.Controls[0]);
        WebB := fr.WebBrowser1;
        if IsChild(WebB.Handle, hWnd) then
        begin
          with WebB.Application as IOleInPlaceActiveObject do
            Handled := TranslateAccelerator(Msg) = S_OK;
          if not Handled then
          begin
            Handled := True;
            TranslateMessage(Msg);
            DispatchMessage(Msg);
          end;
        end;
      end;
    except
    end;
end;procedure TForm1.FormShow(Sender: TObject);
var
  wb: TWebBrowser;
  T: TTabSheet;
  wf: TWebFrame;
  urls: TStringList;
  i: integer;
  url: string;
begin
  urls := TStringList.Create();
  if FileExists(setFile) then
    urls.LoadFromFile(setFile)
  else
    urls.Add(getAhjoeHome());
  for i := 0 to urls.Count-1 do
  begin
    url := Trim(urls[i]);
    if url <> '' then
    begin
      wb := NewBrowsePage(url);
      wb.Navigate(url);
      urlEdit.Text := url;
    end;
  end;
  urls.Free;
end;function TForm1.NewBrowsePage(cap: string): TWebBrowser;
var
  T: TTabSheet;
  wf: TWebFrame;
begin
  T := TTabsheet.Create(self);
  T.Caption := cap;
  T.PageControl :=  PageControl1;
  T.TabVisible := True;
  PageControl1.ActivePage := T;
  wf := TWebFrame.Create(self);
  wf.Name := 'WF' + IntToStr(Random(1000000));
  wf.Parent := T;
  wf.Align := alClient;
  Result := Pointer(wf.Controls[0]);
end;procedure TForm1.urlEditKeyPress(Sender: TObject; var Key: Char);
var
  wf: TWebFrame;
  wb: TWebBrowser;
  url: string;
  i: integer;
begin
  url := Trim(urlEdit.Text);
  if (Key = #13) and (url <> '') then
  begin
    for i := 0 to PageControl1.PageCount-1 do
    begin
      wf := Pointer(PageControl1.Pages[i].Controls[0]);
      wb := wf.WebBrowser1;
      if wb.LocationURL = url then
      begin
        PageControl1.ActivePageIndex := i;
        Exit;
      end;
    end;
    wb := NewBrowsePage(url);
    wb.Navigate(url);
    urlEdit.Text := url;
  end;
end;procedure TForm1.N1Click(Sender: TObject);
var
  wb: TWebBrowser;
  wf: TWebFrame;
begin
  wf := Pointer(PageControl1.ActivePage.Controls[0]);
  wb := wf.WebBrowser1;
  wb.Free();
  wf.Free();
  PageControl1.ActivePage.Free();
  PageControl1Change(nil);
end;procedure TForm1.N2Click(Sender: TObject);
begin
  while PageControl1.PageCount > 0 do
    N1CLick(nil);
end;procedure TForm1.btGotoClick(Sender: TObject);
var
  url: string;
  Key: Char;
begin
  url := Trim(urlEdit.Text);
  Key := #13;
  if url <> '' then
    urlEditKeyPress(nil, Key);
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := LongName;
  setFile := FullPath2Dir(Application.ExeName) + 'MyBrSet.dat';
  Application.OnMessage := AppMessageProc;
end;procedure TForm1.PageControl1Change(Sender: TObject);
var
  wb: TWebBrowser;
  wf: TWebFrame;
begin
  if PageControl1.PageCount > 0 then
  begin
    wf := Pointer(PageControl1.ActivePage.Controls[0]);
    wb := wf.WebBrowser1;
    urlEdit.Text := wb.LocationURL;
  end
  else
    urlEdit.Text := '';
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
  N2Click(nil);
end;procedure TForm1.btSaveClick(Sender: TObject);
var
  urls: TStringList;
  i: integer;
  wb: TWebBrowser;
  wf: TWebFrame;
  foundahjoe: Boolean;
begin
  foundahjoe := False;
  urls := TStringList.Create();
  for i := 0 to PageControl1.PageCount-1 do
  begin
    wf := Pointer(PageControl1.Pages[i].Controls[0]);
    wb := wf.WebBrowser1;
    if wb.LocationURL = getAhjoeHome() then
      foundahjoe := True;
    urls.Add(wb.LocationURL);
  end;
  if not foundahjoe then
    urls.Insert(0, getAhjoeHome());
  urls.SaveToFile(setFile);
  urls.Free();
end;procedure TForm1.urlEditChange(Sender: TObject);
begin
  if Trim(urlEdit.Text) = '' then
    btGoto.ShowHint := False
  else
  begin
    btGoto.ShowHint := True;
    btGoto.Hint := '转到"'+Trim(urlEdit.Text)+'"';
  end;
end;var
  TimerCounter: integer=0;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Inc(TimerCounter);
  if TimerCounter = 120 then
  begin
    Timer1.Enabled := False;
    Caption := ShortName;
  end;
end;initialization
  OleInitialize(nil);finalization
  OleUninitialize;end.

Answer 3

object Form1: TForm1
  Left = 91
  Top = 135
  Width = 698
  Height = 483
  Caption = 'Mini Browser'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = 12
  Font.Name = '宋体'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 12
  object PageControl1: TPageControl
    Left = 0
    Top = 26
    Width = 690
    Height = 430
    Align = alClient
    PopupMenu = PopupMenu1
    TabOrder = 0
    OnChange = PageControl1Change
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 690
    Height = 26
    Align = alTop
    TabOrder = 1
    object Label1: TLabel
      Left = 43
      Top = 6
      Width = 42
      Height = 12
      Caption = '地址(D)'
    end
    object btGoto: TSpeedButton
      Left = 630
      Top = 1
      Width = 58
      Height = 24
      Anchors = [akTop, akRight]
      Caption = '转到'
      Flat = True
      Glyph.Data = {
        E6040000424DE604000000000000360000002800000014000000140000000100
        180000000000B004000000000000000000000000000000000000CCD4D8E7EAEC
        FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFEFDFCFEFDFCFE
        FAFCFCFDFCFDFCFFFFFEFFFFFFFDFEFEE8ECEDCCD4D8E8ECEDD0E1D0297B290E
        670E126C12136C13156C15136B16166F151972181B741B157916147A140F7611
        097309057103016B02207420CFDFCFE8ECEDFDFEFE298829147F141C821C2287
        22268826278927258925248B24248B24238B221893191592140F950F0B950A05
        9205038B02017B01207320FFFFFFFFFFFF0F840F1D8C1D299229309630349834
        359935329932329A313298322A9A2A229D221B9F1A14A1140EA60E09A408039D
        03018901016801FFFFFFFFFFFF158A152693263298323A9D3A3E9F3E3EA03E3C
        A03C3AA13AA4D4A4FFFFFF29A32821A52019A91912AA120CAB0C06A506039203
        026C02FFFFFFFFFFFF198C192F972F3B9D3B43A14347A34746A44644A44440A5
        42FFFFFFFFFFFFFFFFFF25AB251DAD1D16B0160FAF0F0BA90A069506036F03FF
        FFFFFFFFFF1F8F1F379B3743A0434AA44A4DA64D4BA64B48A64945A74641A843
        FFFFFFFFFFFFFFFFFF1FB12019B21913B0130EA90E0C960C077107FFFFFFFFFF
        FF2693263E9E3E49A3494FA64F51A8514FA84F4CA74C48A84847A8483EAA40FF
        FFFFFFFFFFFFFFFF1BB01B17AF1714A7141197110B720BFFFFFFFFFFFF2C952C
        45A1454FA74F53A85354A95452A9524EA84E49A74947A84741AA3E34AC34FFFF
        FFFFFFFFFFFFFF19AC1918A619179715107610FFFFFFFFFFFF2C952C45A1454F
        A74FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
        FFFFFFFFFFFF19A619179816107512FFFFFFFFFFFF2C952C45A1454FA74FFFFF
        FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
        FFFF19A519179817107412FFFFFFFFFFFF3398334CA54C55A95557AA5756AA56
        53A8534FA74E4AA64A46A64640A74038A738FFFFFFFFFFFFFFFFFF1EA51D1DA1
        1D1C961D167413FFFFFFFFFFFF389B3852A85258AB585AAB5A58AA5854A85350
        A7514DA64D49A64943A643FFFFFFFFFFFFFFFFFF29A12725A025239F23229422
        187217FFFFFFFFFFFF4EA64E6FB76F71B9716BB56B63AF635CAB5B55A85651A7
        514DA74DFFFFFFFFFFFFFFFFFF36A1352F9E2E2D9B2C2E972D2D8E2D1E721EFF
        FFFFFFFFFF53A8537ABD7A7DBE7D72B97268B36861AE615DAB5C58A858FFFFFF
        FFFFFFFFFFFF44A4443EA13E389E38339A333197312D8D2D1E721EFFFFFFFFFF
        FF59AC5989C4898DC68D80BF8072B8726BB46B65B1655FAE5FB5DAB5FFFFFF51
        A9524BA64C46A34641A0413B9D3B3599352B8C2B196F19FFFFFFFFFFFF66B266
        97CB979ACD9A89C4897BBD7B73B9736EB66E69B36966B2675EAF6057AB5850A8
        524DA74E4BA44B44A144389A38298B29166C16FFFFFFFFFFFF77BB7790C89094
        CA9485C28576BB766FB76F69B46967B26767B16765B26556AC5953A95550A64F
        4AA54A40A040339833248924317F31FCFCFCE7EAECDCEDDC74B97461B06156AA
        564EA64E49A34943A04345A14545A24546A1463D9D3C359A35349A3431983229
        942A208D20358F35D2E3D2E7EAECCCD4D8E7EAECFCFCFCFFFFFFFFFFFFFFFFFF
        FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFF
        FFFFFFFFE8ECEDCCD4D8}
      ParentShowHint = False
      ShowHint = False
      OnClick = btGotoClick
    end
    object btSave: TSpeedButton
      Left = 5
      Top = 1
      Width = 28
      Height = 24
      Hint = '保存当前打开页面为起始页'
      Flat = True
      Glyph.Data = {
        26050000424D260500000000000036040000280000000F0000000F0000000100
        080000000000F000000000000000000000000001000000000000000000000000
        80000080000000808000800000008000800080800000C0C0C000C0DCC000F0CA
        A6000020400000206000002080000020A0000020C0000020E000004000000040
        20000040400000406000004080000040A0000040C0000040E000006000000060
        20000060400000606000006080000060A0000060C0000060E000008000000080
        20000080400000806000008080000080A0000080C0000080E00000A0000000A0
        200000A0400000A0600000A0800000A0A00000A0C00000A0E00000C0000000C0
        200000C0400000C0600000C0800000C0A00000C0C00000C0E00000E0000000E0
        200000E0400000E0600000E0800000E0A00000E0C00000E0E000400000004000
        20004000400040006000400080004000A0004000C0004000E000402000004020
        20004020400040206000402080004020A0004020C0004020E000404000004040
        20004040400040406000404080004040A0004040C0004040E000406000004060
        20004060400040606000406080004060A0004060C0004060E000408000004080
        20004080400040806000408080004080A0004080C0004080E00040A0000040A0
        200040A0400040A0600040A0800040A0A00040A0C00040A0E00040C0000040C0
        200040C0400040C0600040C0800040C0A00040C0C00040C0E00040E0000040E0
        200040E0400040E0600040E0800040E0A00040E0C00040E0E000800000008000
        20008000400080006000800080008000A0008000C0008000E000802000008020
        20008020400080206000802080008020A0008020C0008020E000804000008040
        20008040400080406000804080008040A0008040C0008040E000806000008060
        20008060400080606000806080008060A0008060C0008060E000808000008080
        20008080400080806000808080008080A0008080C0008080E00080A0000080A0
        200080A0400080A0600080A0800080A0A00080A0C00080A0E00080C0000080C0
        200080C0400080C0600080C0800080C0A00080C0C00080C0E00080E0000080E0
        200080E0400080E0600080E0800080E0A00080E0C00080E0E000C0000000C000
        2000C0004000C0006000C0008000C000A000C000C000C000E000C0200000C020
        2000C0204000C0206000C0208000C020A000C020C000C020E000C0400000C040
        2000C0404000C0406000C0408000C040A000C040C000C040E000C0600000C060
        2000C0604000C0606000C0608000C060A000C060C000C060E000C0800000C080
        2000C0804000C0806000C0808000C080A000C080C000C080E000C0A00000C0A0
        2000C0A04000C0A06000C0A08000C0A0A000C0A0C000C0A0E000C0C00000C0C0
        2000C0C04000C0C06000C0C08000C0C0A000F0FBFF00A4A0A000808080000000
        FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00080000000000
        0000000000080808080000030300000000070003000808080800000303000000
        0007000300000008080000030300000000000003000300080800000303030303
        0303030300030000000000030300000000000303000300030000000300070707
        0707000300030003000000030007070707070003000300030000000300070707
        0707000000030003000000030007070707070007000300030000000000000000
        0000000000000003000008080003000707070707000700030000080800000000
        0000000000000000000008080808000300070707070700070000080808080000
        00000000000000000000}
      ParentShowHint = False
      ShowHint = True
      OnClick = btSaveClick
    end
    object urlEdit: TEdit
      Left = 88
      Top = 3
      Width = 542
      Height = 20
      Anchors = [akLeft, akTop, akRight]
      TabOrder = 0
      OnChange = urlEditChange
      OnKeyPress = urlEditKeyPress
    end
  end
  object PopupMenu1: TPopupMenu
    Left = 36
    Top = 57
    object N1: TMenuItem
      Caption = '关闭本页(&C)'
      OnClick = N1Click
    end
    object N2: TMenuItem
      Caption = '关闭全部(&X)'
      OnClick = N2Click
    end
  end
  object Timer1: TTimer
    OnTimer = Timer1Timer
    Left = 152
    Top = 128
  end
end

Answer 4

// fr.pas
unit fr;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtrls, SHDocVw, ComCtrls;type
  TWebFrame = class(TFrame)
    WebBrowser1: TWebBrowser;
    procedure WebBrowser1TitleChange(Sender: TObject;
      const Text: WideString);
    procedure WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch;
      var Cancel: WordBool);
    procedure WebBrowser1BeforeNavigate2(Sender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
  private
    { Private declarations }
  public
    { Public declarations }
  end;implementation{$R *.DFM}
uses MyBrwU;procedure TWebFrame.WebBrowser1TitleChange(Sender: TObject;
  const Text: WideString);
var
  T: TTabSheet;
begin
  T := Pointer(Parent);
  T.Caption := Text;
end;procedure TWebFrame.WebBrowser1NewWindow2(Sender: TObject;
  var ppDisp: IDispatch; var Cancel: WordBool);
var
  wb: TWebBrowser;
begin
  wb := Form1.NewBrowsePage('新页面');
  ppDisp := wb.DefaultDispatch;
end;procedure TWebFrame.WebBrowser1BeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
  if (TargetFrameName = '') or (Copy(TargetFrameName, 1, 10) = '_No__Name:') then
    Form1.urlEdit.Text := URL;
end;end.