delphi实现自制IE浏览器
来源:互联网 发布:cpa视频网站源码 编辑:程序博客网 时间:2024/05/01 07:15
个人认为 做 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.
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 上编译通过...
图如下..
- delphi实现自制IE浏览器
- 自制IE浏览器
- Delphi开发嵌入式IE浏览器监控程序
- 自制浏览器
- 实现IE浏览器全屏幕操作
- Delphi 获取浏览器路径 注册表获取默认浏览器、注册表读取IE路径 拼接IE路径
- Qt 自制文件浏览器并实现按照扩展名过滤
- 用Delphi编程控制IE浏览器的窗口
- delphi仿IE浏览器标签页效果演示
- 自制简单浏览器界面
- 自制Android 文件浏览器
- 自制浏览器右键菜单
- 实现IE浏览器部分菜单命令
- IE浏览器 自定义地址协议的实现
- 简单IE浏览器的VB实现
- 简单IE浏览器的VB实现
- ie浏览器实现最大化最小化功能
- IE浏览器 自定义地址协议的实现
- 僵尸进程及其避免
- S60 SDK v1.2中模拟器不能用的BUG解决
- 北京纪行之二:开源冲击
- asp生成静态网页的方法-不用模板
- Lazarus - IDE的绝对强者
- delphi实现自制IE浏览器
- 回调函数
- 由于CSDN的BLOG不能上传代码,我现在使用blog.likeshow.net
- helicon 组件实现url地址重写
- 在家里上网
- 从其他服务器上下载数据.通过webclient
- 开始我的XML之旅
- VC设置项目之间的依赖
- 游戏引擎HGE