看看这个对你有没有一点用？
问题: 另借空间，请帮忙解决：如何捕捉TWebBrowser滚动条消息？ ( 积分: 200 )
分类: 控件 - 开发
来自: dsideal, 时间: 2003-07-01 14:07:00, ID: 1993725
TWebBrowser控件的滚动事件消息不能够捕获，但是我想知道滚动的距离尺寸，怎么解决呢？请高手帮忙！！！
1、捕获控件滚动事件（100）
2、滚动尺寸（100）
我用如下代码时出错：
protected
procedure WMVSCroll(var Msg:TWMVSCroll);message WM_VSCROLL;
procedure WMHSCroll(var Msg:TWMHSCroll);message WM_HSCROLL;
procedure TWeB.WMVSCroll(var Msg:TWMVSCroll);Message WM_VSCROLL;
begin
ShowMessage('垂直滚动');
end;
procedure TWeB.WMHSCroll(var Msg:TWMHSCroll);message WM_HSCROLL;
begin
ShowMessage('水平滚动');
end;
Error:unknown directive 'message'
来自: dsideal, 时间: 2003-07-01 15:07:00, ID: 1993932
出错的原因我知道了。但是我的WebBrowser控件还是捕获不到滚动事件，Memo控件都可以。
难道没有人知道这个问题？回答测试后一定给分。。。。。。。。。。。。。
来自: settingsun, 时间: 2003-07-01 15:29:00, ID: 1994022
重写WebBrowser的WindowProc窗口函数,在里面处理WM_VSCROLL或者WM_HSCROLL等消息
如:先声明
WebOldWndProc:TWndMethod;
procedure WebBrowserWndProc(var Msg: TMessage);
WebOldWndProc:=WebBrowser1.WindowProc;
WebBrowser1.WindowProc:=WebBrowserWndProc;
procedure TForm1.WebBrowserWndProc(var Msg: TMessage);
begin
WebOldWndProc(Msg);
if (Msg.Msg = WM_VSCROLL) then
....
if (Msg.Msg = WM_HSCROLL) then
....
if (Msg.Msg = WM_MOUSEWHEEL) then
...
试试看
来自: dsideal, 时间: 2003-07-01 15:46:00, ID: 1994112
楼上的方法我试过了，我也是这么做的。但是滚动消息就是截获不到，并且程序无法跟踪。我的代码如下：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, OleCtrls, SHDocVw, WeB;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Button2: TButton;
Memo1: TMemo;
Web1: TWebBrowser;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
OldProc: TWndMethod;
procedure MyWndProc(var Message: TMessage);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.MyWndProc(var Message: TMessage);
begin
case Message.Msg of
WM_HSCROLL:
ShowMessage('水平');
WM_VSCROLL:
ShowMessage('垂直');
WM_LBUTTONDOWN:
ShowMessage('按下');
end;
OldProc(Message);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Web1.Navigate(Edit1.Text);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
//PostMessage(GetWindow(GetWindow(lv1.Handle, GW_CHILD), GW_CHILD), WM_VSCROLL, SB_BOTTOM, 0);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
OldProc := Web1.WindowProc;
Web1.WindowProc := MyWndProc;
Web1.Navigate('www.sina.com.cn');
//OldProc := Memo1.WindowProc;
//Memo1.WindowProc := MyWndProc;
end;
end.
来自: dsideal, 时间: 2003-07-02 8:07:00, ID: 1995458
谁知道TWebBrowser的滚动事件和其他控件的滚动事件有什么区别？请各位高手帮忙？难道没有人知道？我可以全分奉送以表谢意。我的Email:xuqiang@dsideal.com
来自: LiChaoHui, 时间: 2003-07-02 10:24:00, ID: 1995939
TWebBrowser的滚动条是其文档对象模型内部的东西,
通过COM变成可以获得这个事件,但是只有一个onscroll事件,
不能区别滚动的方向,你可以根据当前的滚动位置来判断是什么方向上的滚动
下面是我给你写的一个程序,在窗口的标题栏中即时显示滚动位置
我查了半天的在线MSDN,还调试了半天,不知道是否能满足你的要求
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, SHDocVw, ActiveX, ComObj, MSHtml;
type
TForm1 = class(TForm, IUnknown, IDispatch)
WebBrowser1: TWebBrowser;
Button1: TButton;
procedure Button1Click(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 }
protected
FRefCount: Integer;
{ Points to the old event handler (e.g. JavaScript function) }
FEventDisp: IDispatch;
{ IUnknown }
function QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
{ IDispatch }
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
function GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate('http://www.skycn.com/');
end;
function TForm1._AddRef: Integer;
begin
Inc(FRefCount);
Result := FRefCount;
end;
function TForm1._Release: Integer;
begin
Dec(FRefCount);
Result := FRefCount;
end;
function TForm1.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount,
LocaleID: Integer; DispIDs: Pointer): HResult;
begin
if FEventDisp <> nil then
Result := FEventDisp.GetIDsOfNames(IID, Names, NameCount, LocaleID, DispIDs)
else
Result := E_NOTIMPL;
end;
function TForm1.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
if FEventDisp <> nil then
Result := FEventDisp.GetTypeInfo(Index, LocaleID, TypeInfo)
else begin
Pointer(TypeInfo) := nil;
Result := E_NOTIMPL;
end
end;
function TForm1.GetTypeInfoCount(out Count: Integer): HResult;
begin
if FEventDisp <> nil then
Result := FEventDisp.GetTypeInfoCount(Count)
else begin
Count := 0;
Result := S_OK;
end;
end;
function TForm1.QueryInterface(const IID: TGUID; out Obj): Integer;
begin
if GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;
procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
begin
Cancel := True;
end;
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
vDoc: OleVariant;
begin
vDoc := WebBrowser1.Document;
vDoc.parentWindow.attachEvent('onscroll', Self as IDispatch);
end;
function TForm1.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
var
vDoc: OleVariant;
vEle: OleVariant;
vEvt: OleVariant;
begin
Result := S_OK;
vDoc := WebBrowser1.Document;
vEvt := vDoc.parentWindow.event;
vEle := vEvt.srcElement;
Caption := IntToStr(vDoc.body.scrollLeft) + ',' +
IntToStr(vDoc.body.scrollTop);
end;
end.
来自: LiChaoHui, 时间: 2003-07-02 10:31:00, ID: 1995963
实现的原理是,当前对象实现一个IDispatch接口,
利用WebBrowser内部对象的attatchEvent方法,关联事件,
并在事件的回调中执行代码,
我的一个组件包Virtual Web Server 中有个组件将所有的东西都封装了,
可以很容易的拦截各种事件,包括你所说的要求
使用组件时的代码如下:
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
WebEvent1.StandardTags := 'window';
WebEvent1.EventsToFire := 'onscroll';
WebEvent1.EvtSource := WebBrowser1;
WebEvent1.AttachEvents;
end;
procedure TForm1.WebEvent1Event(Sender: TWebBrowser; event,
SrcElement: OleVariant);
var
vDoc: OleVariant;
vEle: OleVariant;
vEvt: OleVariant;
begin
vDoc := WebBrowser1.Document;
vEvt := vDoc.parentWindow.event;
vEle := vEvt.srcElement;
Caption := IntToStr(vDoc.body.scrollLeft) + ',' +
IntToStr(vDoc.body.scrollTop);
end;
还可以同时拦截其它的事件,避免了实现IDispatch接口
playicq上面有下载
来自: dsideal, 时间: 2003-07-02 10:35:00, ID: 1995977
首先对LiChaoHui表示感谢，我现在看看你的程序，一定给分。。。谢谢。。。
来自: dsideal, 时间: 2003-07-02 10:43:00, ID: 1996005
TO： LiChaoHui 请问Playicq是什么？不要笑我，我没有用过。或者你可以将程序发到我的
邮箱：xuqiang@dsideal.com么？
来自: dsideal, 时间: 2003-07-02 10:49:00, ID: 1996028
可以把你的控件发给我么？发完后我就要结帖给分了，谢谢！！！！！可以把你的EMAIL告诉我么？我以后好向你请教，或者QQ。多谢了。
来自: dsideal, 时间: 2003-07-02 10:53:00, ID: 1996045
我找到Playicq网址了。我先看看
来自: dsideal, 时间: 2003-07-02 10:59:00, ID: 1996077
我没有找到你说的组件包Virtual Web Server 能给我发一份么？谢谢！！！！
来自: LiChaoHui, 时间: 2003-07-02 11:06:00, ID: 1996097
已经发送了,请查收,是一个组件的单元文件,自行安装即可
或者复制此文件到当前目录,动态创建组件也可以
来自: LiChaoHui, 时间: 2003-07-02 11:11:00, ID: 1996119
这个给你个下载地址
http://new.playicq.com/dispdocnew.php?id=5018
ftp://guest:guestguest@61.129.70.192/control/virtsite1.1.rar
来自: dsideal, 时间: 2003-07-02 11:14:00, ID: 1996132
先将分给你，多谢了。我自己研究研究，有问题给你Mail.万分感谢！·！！！
来自: dsideal, 时间: 2003-07-02 11:15:00, ID: 1996135
多人接受答案了。
得分大富翁: LiChaoHui-180,settingsun-20,
]