上一篇 |

Delphi

自制一个MyIE

作者:webfly 日期:2008-03-12

字体大小: 小中大

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;

procedure TForm1.ToolButton2Click(Sender: TObject);

begin

Try

WebBrowser1.GoForward;

except

showmessage('不能再前进了');

exit;

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;

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;

procedure TForm1.ToolButton9Click(Sender: TObject);

begin

try

webbrowser1.ExecWB(olecmdid_saveas,2);

except

exit;

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;

procedure TForm1.TabSheet1Exit(Sender: TObject);

begin

self.Free;

end;

end.

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

图如下..

==========================================================================

procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
var
newtab : TTabSheet;
newweb : TWebBrowser;
begin
newtab := TTabSheet.Create(Self) ;
newtab.PageControl := PageControl1;
newtab.Caption := 'PageControl1';
newweb := TWebBrowser.Create(self);
newweb.ParentWindow := newtab.Handle;
TOleControl(newweb).Parent :=newtab; //加入此行
newweb.OnNewWindow2 := WebBrowser1.OnNewWindow2
newweb.Align := alClient;
ppDisp := newweb.DefaultDispatch;
end;

發表於 - 2003/03/03 : 10:36:35
--------------------------------------------------------------------------------
要取得瀏覽器中網頁的 title 必須要在網頁下載完成後,
取用其 document 中的 title 即可. 所以你可以先寫在 DocumentComplete event 中, 如下,
即可取得文件中的 title!!

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;

================
以下是本人写的例子
unit uMain_URL;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, OleCtrls, SHDocVw,activex,MSHTML;//MSHTML_TLB;

type
TForm1 = class(TForm)
PageControl1: TPageControl;
StatusBar1: TStatusBar;
Panel1: TPanel;
Edit1: TEdit;
TabSheet1: TTabSheet;
WebBrowser1: TWebBrowser;
procedure Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);

private
{ Private declarations }
first:integer;
web:TWebBrowser;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key=13 then
begin
self.web.Navigate(self.Edit1.Text);
first:=1;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
self.web:=TWebBrowser.Create(self);
end;

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

procedure TForm1.FormShow(Sender: TObject);
begin
self.web:=self.WebBrowser1;
end;

procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
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;

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.web:=subweb;
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;

end.

[本日志由 webfly 于 2008-03-13 10:22 PM 编辑]

文章来自: 本站转贴

引用通告: 查看所有引用 | 我要引用此文章

Tags: MyIE WebBrowser

相关日志:

评论: 0 | 引用: 0 | 查看次数: -

发表评论

昵　称:
密　码:	游客发言不需要密码.
内　容:	正在加载编辑器...
验证码:
选　项:	禁止表情转换禁止自动转换链接禁止自动转换关键字记住我的信息,以便下次评论时不用输入用户名.

虽然发表评论不用注册，但是为了保护您的发言权，建议您注册帐号.