delphi实现自制IE浏览器

个人认为 做 IE  外壳  用 VB 比较好....

delphi 的代码如下: 请根据 需要 向窗体内 添加相应的 组件...

 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ImgList, ToolWin, OleCtrls, SHDocVw, ExtCtrls, Menus,
  StdCtrls, MSHTML;

type
  TForm1  =   class (TForm)
    Panel2: TPanel;
    ImageList1: TImageList;
    StatusBar1: TStatusBar;
    Panel3: TPanel;
    ComboBox1: TComboBox;
    Button1: TButton;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton7: TToolButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    WebBrowser1: TWebBrowser;
    PopupMenu1: TPopupMenu;
    Nclose: TMenuItem;
    N2: TMenuItem;
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure WebBrowser1DownloadBegin(Sender: TObject);
    procedure WebBrowser1DownloadComplete(Sender: TObject);
    procedure WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch;
      var Cancel: WordBool);
    procedure FormResize(Sender: TObject);
    procedure ComboBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ToolButton9Click(Sender: TObject);
    procedure ToolButton10Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure WebBrowser1DocumentComplete(Sender: TObject;
       const  pDisp: IDispatch; var URL: OleVariant);
    procedure NcloseClick(Sender: TObject);
    procedure TabSheet1Exit(Sender: TObject);
   private
   first:integer;
    /**/ ///tabID  :  integer;//在这里定义全局变量 
     ... { Private declarations }
   public
     ... { Public declarations }
  end;

var
  Form1: TForm1;

implementation

... {$R *.dfm}

procedure TForm1.ToolButton1Click(Sender: TObject);
begin
  Try
    WebBrowser1.GoBack;
  except
    showmessage( ' 不能再后退了 ' );
    exit;
  end;
end;

procedure TForm1.ToolButton2Click(Sender: TObject);
begin
   Try
     WebBrowser1.GoForward;
   except
     showmessage( ' 不能再前进了 ' );
     exit;
   end;
end;

procedure TForm1.ToolButton3Click(Sender: TObject);
begin
webbrowser1.Stop;
end;

procedure TForm1.ToolButton4Click(Sender: TObject);
begin
webbrowser1.GoHome;
end;

procedure TForm1.ToolButton5Click(Sender: TObject);
begin
webbrowser1.Refresh;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 webbrowser1.Navigate(combobox1.Text,EmptyParam,EmptyParam,EmptyParam,EmptyParam);
 first: = 1 ;

 end;

procedure TForm1.WebBrowser1DownloadBegin(Sender: TObject);
begin
statusbar1.Panels[ 0 ].Text : =   ' 正在下载... ' ;
end;

procedure TForm1.WebBrowser1DownloadComplete(Sender: TObject);
begin
statusbar1.Panels[ 0 ].Text : =   ' 完成 ' ;
combobox1.Text : =  webbrowser1.LocationURL;
end;

procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
  var ppDisp: IDispatch; var Cancel: WordBool);
// 第一种方法
... {var   newForm: TForm1;
  begin
    newForm := TForm1.Create(nil);//Application);
    //newForm.Close := TForm1FormClose;
    newForm.Caption:='MDIForm';
    WebBrowser1.OnNewWindow2:=webbrowser1NewWindow2;
    //newform.BorderIcons := [bisystemmenu,bimaximize];
    //newform.WindowState := wsMaximized;
    newForm.Visible:=true;
    ppDisp :=  newform.WebBrowser1.ControlInterface;
    Cancel:=false;
end;}
// 第二种方法
... {var
        tab:TTabSheet;
        subweb:TWebBrowser;
  begin
        if first=0 then Exit;
                tab:=TTabSheet.Create(self);
                tab.Parent:=self.PageControl1;
                tab.PageControl:=self.PageControl1;
                Self.PageControl1.ActivePage:=tab;
                tab.Align:=alClient;
                tab.Visible:=True;
                tab.Caption := '正在加载...';
                //tabID  :=  Longint(tab);

                subweb:=TWebBrowser.Create(tab);
                subweb.ParentWindow := tab.Handle;
                TOleControl(subweb).Parent :=tab;
                subweb.OnNewWindow2:=self.WebBrowser1NewWindow2;
                subweb.OnDocumentComplete:=self.WebBrowser1DocumentComplete;
                subweb.Align:=alClient;
                subweb.Visible:=True;
                ppDisp := subweb.DefaultDispatch;
                Self.WebBrowser1:=subweb;

    //ppDisp :=  newtab.WebBrowser1.ControlInterface;
    //Cancel:=false;
end;}
var
        tab:TTabSheet;
         // subweb:TWebBrowser;
  begin
         if  first = 0  then Exit;
                tab: = TTabSheet.Create(nil);
                tab.Parent: = self.PageControl1;
                tab.PageControl: = self.PageControl1;
                Self.PageControl1.ActivePage: = tab;
                tab.Align: = alClient;
                tab.Visible: = True;
                tab.Caption : =   ' 正在加载... ' ;
                 // tabID  :=  Longint(tab);

                WebBrowser1: = TWebBrowser.Create(tab);
                WebBrowser1.ParentWindow : =  tab.Handle;
                TOleControl(WebBrowser1).Parent : = tab;
                WebBrowser1.OnNewWindow2: = self.WebBrowser1NewWindow2;
                WebBrowser1.OnDocumentComplete: = self.WebBrowser1DocumentComplete;
                WebBrowser1.Align: = alClient;
                WebBrowser1.Visible: = True;
                ppDisp : =  WebBrowser1.DefaultDispatch;
                 // Self.WebBrowser1:=WebBrowser1;

     // ppDisp :=  newtab.WebBrowser1.ControlInterface;
     // Cancel:=false;
end;


procedure TForm1.FormResize(Sender: TObject);
begin
         try
panel2.Left : =   0  ;
panel2.Align : =  alClient;
webbrowser1.Left : =   0 ;
webbrowser1.Top : =   0 ;
webbrowser1.Align : =  alClient;
pagecontrol1.align: = alclient;
        except
                exit;
        end;
end;

procedure TForm1.ComboBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if  Key = 13  then
begin
self.webbrowser1.Navigate(self.ComboBox1.Text,EmptyParam,EmptyParam,EmptyParam,EmptyParam);
end;

end;

procedure TForm1.ToolButton9Click(Sender: TObject);
begin
   try
webbrowser1.ExecWB(olecmdid_saveas, 2 );
  except
  exit;
  end;
end;

procedure TForm1.ToolButton10Click(Sender: TObject);
begin
if  opendialog1.Execute then
webbrowser1.Navigate(opendialog1.filename);
end;

procedure TForm1.FormShow(Sender: TObject);
begin

form1.Resize;

end;

procedure TForm1.ToolButton6Click(Sender: TObject);
begin
combobox1.Text : =   ' view-source: ' +  combobox1.text;
self.Button1.Click;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Action : =  caFree;
//  form1 :=  nil;
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
   const  pDisp: IDispatch; var URL: OleVariant);
var
hd : iHTMLDocument2;
begin
hd : =  TWebBrowser(Sender).Document  as  IHTMLDocument2;
TTabSheet(TOleControl(Sender).Parent).Caption : =  hd.title;
end;


procedure TForm1.NcloseClick(Sender: TObject);
var
  i: Integer;
   // j: integer;
  ts: TTabSheet;
begin
   ... {for i := PageControl1.PageCount - 1 downto 0 do
  begin
    ts := PageControl1.Pages[i];
    ts.PageControl := nil;
    ts.Free;
  end;}
   try
      i : =  pagecontrol1.ActivePageIndex;
       // j := i -1;
     ts : =  pagecontrol1.Pages[i];
      // ts.PageControl:=nil;
      // ts.Destroy;
      // ts.Free;
     ts.Parent : =  nil;
     ts.Free();
     except
     exit;
     end;
end;


procedure TForm1.TabSheet1Exit(Sender: TObject);
begin
self.Free;
end;

end.

 

以上代码在  Window2000  delphi 6  上编译通过...

图如下..