Delphi知识中心
www.delphi.ee
提供Delphi技术知识
与Delphi程序员共同进步


在线服务QQ:99923144 随时恭候您的光临
首页 基础知识 WIN系统 组件使用 组件开发 数据库 ACTIVEX 多媒体技术 网络技术 关于
文章类别:网络技术    你尚未登陆,会员功能无法使用,请从 网站首页 登陆。
  Delphi 中WebBrowser控件详解实例  
 
Delphi 中WebBrowser控件详解实例 - []

很久都没有原创了,前几天帮朋友做了个网址发布程序,主要应用到了WebBrowser控件。

今天主要给大家演示一下过程,让大家学习一下Delphi工具。

WebBrowser功能:

1。自动加载网页

2。去除WebBrowser滚动条

3。WebBrowser自身打开页面

4。禁止右键

1。首先,新建一个FROM窗体:

Delphi 中WebBrowser控件详解实例 - wxmijl - 我的博客我做主

2。加入一个WEBBROWSER控件

Delphi 中WebBrowser控件详解实例 - wxmijl - 我的博客我做主

Delphi 中WebBrowser控件详解实例 - wxmijl - 我的博客我做主

3。调整后如下:

Delphi 中WebBrowser控件详解实例 - wxmijl - 我的博客我做主

4.这样一个webbrowser就完成了,下一步我们来让程序打开后自动加载一个网页。

核心代码:WebBrowser1.Navigate('http://v.28.la');

双击窗体灰色处,对窗体进行初始化,在代码窗口中输入(Begin 与 End间输入核心代码):

procedure TForm1.FormCreate(Sender: TObject);

begin

WebBrowser1.Navigate('http://v.28.la'); //窗体初始化完成WEBBROWSER加载一个网页

end;

5。下面我们来实现禁止WEBBROWSER控件的滚动条功能:

核心代码:WebBrowser1.oleobject.Document.body.Scroll:= ‘no’;

利用这个代码去掉滚动条的前提是webbrowser中必须有打开的网页,也就是在网页加载完

完毕后再去掉滚动条。所以首先要判断页面是否加载完毕,如果加载完毕,就执行上面的语句

去掉滚动条。这时就要引入一个按扭控件来触发程序

加入SPEEDBUTTEN

Delphi 中WebBrowser控件详解实例 - wxmijl - 我的博客我做主

Delphi 中WebBrowser控件详解实例 - wxmijl - 我的博客我做主

调整形后:

Delphi 中WebBrowser控件详解实例 - wxmijl - 我的博客我做主

好了,现在可以实现禁止滚动条的功能了:

第一步:在WebBrowser1DocumentComplete事件中置一个标志tag:=1(代表加载完毕)

单击WEBBROWSER控件,在WebBrowser属性

的EVENS事件中找到WebBrowser1DocumentComplete (双击)

Delphi 中WebBrowser控件详解实例 - wxmijl - 我的博客我做主

然后在代码窗口中输入:

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;

const pDisp: IDispatch; var URL: OleVariant);

begin

tag:=1; //去掉Webbrowser1滚动条的标志

end;

对SpeedButten控件操作:(双击onClick)

Delphi 中WebBrowser控件详解实例 - wxmijl - 我的博客我做主

加入如下代码:

procedure TForm1.SpeedButton1Click(Sender: TObject);

var

Doc: IHTMLDocument2;

begin

tag := 0; //去掉Webbrowser1滚动条的标志

WebBrowser1.Navigate2(’http://www.baidu.com’);

while(tag=0) do Application.ProcessMessages;

WebBrowser1.oleobject.Document.body.Scroll := ‘no’;

end;

注意:使用前必须在uses中加入mshtml;

这样WebBrowser就禁止了滚动条。主要应用到了IHTMLDocument2。

6。

让Webbrowser中的链接点击时在自身窗口打开:(单击WebBrowser控件,属性中的

EVENS事件,双击NewWindow2)

Delphi 中WebBrowser控件详解实例 - wxmijl - 我的博客我做主

代码窗口中输入:

procedure TForm1.WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch;

var Cancel: WordBool);

begin

// 將新視窗在自身開啟

ppdisp := webBrowser1.Application;

end;

7。最后是禁用WebBrowser中的右键功能,放一个ApplicationEvents控件:

Delphi 中WebBrowser控件详解实例 - wxmijl - 我的博客我做主

Delphi 中WebBrowser控件详解实例 - wxmijl - 我的博客我做主

ApplicationEvents控件属性Evens事件中双击Onmessage:

在代码窗口中输入:

Delphi 中WebBrowser控件详解实例 - wxmijl - 我的博客我做主

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;

var Handled: Boolean);

begin

if (Msg.message = wm_rbuttondown) or (Msg.message = wm_rbuttonup) or

(msg.message = WM_RBUTTONDBLCLK) then

begin

if IsChild(Webbrowser1.Handle, Msg.hwnd) then

Handled := true;

end;

end;

到此完成对程序的制作,调试

去滚动条后:

Delphi 中WebBrowser控件详解实例 - wxmijl - 我的博客我做主

--------------------------------------------------------

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

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, OleCtrls, SHDocVw,mshtml, AppEvnts;

type

TForm1 = class(TForm)

WebBrowser1: TWebBrowser;

Button1: TButton;

ApplicationEvents1: TApplicationEvents;

procedure WebBrowser1DocumentComplete(Sender: TObject;

const pDisp: IDispatch; var URL: OleVariant);

procedure Button1Click(Sender: TObject);

procedure ApplicationEvents1Message(var Msg: tagMSG;

var Handled: Boolean);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;

const pDisp: IDispatch; var URL: OleVariant);

begin

tag:=1;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

a: IHTMLDocument2;

begin

tag := 0;

WebBrowser1.Navigate('http://www.baidu.com');

while(tag=0) do Application.ProcessMessages;

WebBrowser1.oleobject.Document.body.Scroll := 'no';

a :=WebBrowser1.Document as IHTMLDocument2;

a.Get_ParentWindow.ScrollBy(0,20);

end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;

var Handled: Boolean);

begin

if (Msg.message = wm_rbuttondown) or (Msg.message = wm_rbuttonup) or

(msg.message = WM_RBUTTONDBLCLK) then

begin

if IsChild(Webbrowser1.Handle, Msg.hwnd) then

Handled := true;

end;

end;

end.

清空页面

webBrowser1.Navigate('about:blank') ;

如何直接载入 HTML 到 WebBrowser

下面的代码演示如何载入一个字符串中的“静态”HTML 到一个 TWebBrowser 中:

用法:简单地拖动一个 TWebBrowser 组件的实例到窗体上,在窗体的 OnCreate 事件中载入 HTML 代码:

procedure WBLoadHTML(WebBrowser: TWebBrowser; HTMLCode: string) ;

var

sl: TStringList;

ms: TMemoryStream;

begin

WebBrowser.Navigate('about:blank') ;

while WebBrowser.ReadyState < READYSTATE_INTERACTIVE do

Application.ProcessMessages;

if Assigned(WebBrowser.Document) then

begin

sl := TStringList.Create;

try

ms := TMemoryStream.Create;

try

sl.Text := HTMLCode;

sl.SaveToStream(ms) ;

ms.Seek(0, 0) ;

(WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms)) ;

finally

ms.Free;

end;

finally

sl.Free;

end;

end;

end;

procedure TForm1.FormCreate(Sender: TObject) ;

var

sHTML : string;

begin

sHTML := 'GOTO' +

'About Delphi Programming';

WBLoadHTML(WebBrowser1,sHTML) ;

end;

 

在线服务QQ:99923144 Delphi程序员QQ群(139442)
Delphi知识中心 www.delphi.ee 最专业的Delphi技术资料网站