LiChaoHui大好人请帮忙啊！！！！TWebBrowser获取鼠标事件(100分)

LiChaoHui 你好，上几天你帮助我解决了Web控件的滚动事件，但是他只有onscroll事件，我是不是换成其他的如：onmousedown就可以捕获到鼠标事件了呢？请赐教。我用另一个方法获取了鼠标事件，但是退出的时候出现错误提示。我捕获鼠标事件代码如下：
//启动监测鼠标事件
procedure TForm1.Button3Click(Sender: TObject);

begin
IEHandle := findWindowEx(WB_Des.Handle, 0, 'Shell DocObject View', nil);
IEHandle := findWindowEx(IEHandle, 0, 'Internet Explorer_Server', nil);
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(IEHandle, GWL_WNDPROC));
SetWindowLong(IEHandle, GWL_WNDPROC, LongInt(FClientInstance));
end;
procedure TForm1.ClientWndProc(var Message: TMessage);
var
Pos_Sou:TPoint;
begin
with Message do
case Msg of
WM_KeyDown:
begin
ShowMessage('WM KeyDown');
Result := CallWindowProc(FPrevClientProc, IEHandle, Msg, wParam, lParam);
end;

WM_LBUTTONDOWN:
begin
ShowMessage('WM Mouse Left Button Down');
Result := CallWindowProc(FPrevClientProc, IEHandle, Msg, wParam, lParam);
end;

WM_MOUSEMOVE:
begin
GetCursorPos(Pos_Sou);
Form1.Caption :=IntToStr(Pos_Sou.X)+','+IntToStr(Pos_Sou.Y);
Result := CallWindowProc(FPrevClientProc, IEHandle, Msg, wParam, lParam);
end;

WM_VSCROLL:
begin
ShowMessage('asdf');
end;
WM_QUIT:
begin
ShowMessage('111');
end;
else
Result := CallWindowProc(FPrevClientProc, IEHandle, Msg, wParam, lParam);
end;
end;
我下面的程序可以获得鼠标事件，但是没有滚动事件。你给我的程序有滚动事件，但没有鼠标事件。两个消息一起捕获在程序退出的时候在我的程序最后一句：else
Result := CallWindowProc(FPrevClientProc, IEHandle, Msg, wParam, lParam);
处出现错误提示：access violation at 0x004583 read of address ....我想是不是消息冲突了。请帮帮忙分析一下好么？

var
Form1: TForm1;
FOleInPlaceActiveObject: IOleInPlaceActiveObject;
SaveMessageHandler: TMessageEvent;

...

implementation

...

procedure TForm1.FormActivate(Sender: TObject);
begin
SaveMessageHandler := Application.OnMessage;
Application.OnMessage := MyMessageHandler;
end;

procedure TForm1.FormDeactivate(Sender: TObject);
begin
Application.OnMessage := SaveMessageHandler;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Application.OnMessage := SaveMessageHandler;
FOleInPlaceActiveObject := nil;
end;

procedure TForm1.MyMessageHandler(var Msg: TMsg; var Handled: Boolean);
var
iOIPAO: IOleInPlaceActiveObject;
Dispatch: IDispatch;
begin
{ exit if we don't get back a webbrowser object }
if WebBrowser = nil then
begin
Handled := False;
Exit;
end;

Handled:=(IsDialogMessage(WebBrowser.Handle, Msg) = True);

if Handled then
begin
if FOleInPlaceActiveObject = nil then
begin
Dispatch := WebBrowser1.ControlInterface;
if Dispatch <> nil then
begin
Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO);
if iOIPAO <> nil then
FOleInPlaceActiveObject := iOIPAO;
end;
end;

if FOleInPlaceActiveObject <> nil then
if ((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)) and
((Msg.wParam = VK_BACK) or (Msg.wParam = VK_LEFT) or
(Msg.wParam =VK_RIGHT) or (Msg.wParam = VK_SHIFT) or
(Msg.wParam = VK_TAB) or (Msg.wParam = VK_DELETE)) then
{ nothing - do not pass on Backspace, Left or Right arrows or tab or delete }
else
FOleInPlaceActiveObject.TranslateAccelerator(Msg)
end;
end;

TO: alol 我不明白你的代码是什么意思，能够帮助解释一下么？并且IOleInPlaceActiveObject 是什么类型呢？系统不认识。。。。等待。。。

首先找一个类实现IDispatch接口
就叫classA吧。
其次得到TWebBrowser的IWebBrowser接口
IE := WebBrowser1 as IWebbrowser2;
然后
InterfaceConnect(IE, HTMLDocumentEvents2, classA, FConnection);
在classA的Invoke函数里
就可以截获很多事件，包括
HTMLDocumentEvents2 = dispinterface
['{3050F613-98B5-11CF-BB82-00AA00BDCE0B}']
function onhelp(const pEvtObj: IHTMLEventObj): WordBool; dispid -2147418102;
function onclick(const pEvtObj: IHTMLEventObj): WordBool; dispid -600;
function ondblclick(const pEvtObj: IHTMLEventObj): WordBool; dispid -601;
procedure onkeydown(const pEvtObj: IHTMLEventObj); dispid -602;
procedure onkeyup(const pEvtObj: IHTMLEventObj); dispid -604;
function onkeypress(const pEvtObj: IHTMLEventObj): WordBool; dispid -603;
procedure onmousedown(const pEvtObj: IHTMLEventObj); dispid -605;
procedure onmousemove(const pEvtObj: IHTMLEventObj); dispid -606;
procedure onmouseup(const pEvtObj: IHTMLEventObj); dispid -607;
procedure onmouseout(const pEvtObj: IHTMLEventObj); dispid -2147418103;
procedure onmouseover(const pEvtObj: IHTMLEventObj); dispid -2147418104;
procedure onreadystatechange(const pEvtObj: IHTMLEventObj); dispid -609;
function onbeforeupdate(const pEvtObj: IHTMLEventObj): WordBool; dispid -2147418108;
procedure onafterupdate(const pEvtObj: IHTMLEventObj); dispid -2147418107;
function onrowexit(const pEvtObj: IHTMLEventObj): WordBool; dispid -2147418106;
procedure onrowenter(const pEvtObj: IHTMLEventObj); dispid -2147418105;
function ondragstart(const pEvtObj: IHTMLEventObj): WordBool; dispid -2147418101;
function onselectstart(const pEvtObj: IHTMLEventObj): WordBool; dispid -2147418100;
function onerrorupdate(const pEvtObj: IHTMLEventObj): WordBool; dispid -2147418099;
function oncontextmenu(const pEvtObj: IHTMLEventObj): WordBool; dispid 1023;
function onstop(const pEvtObj: IHTMLEventObj): WordBool; dispid 1026;
procedure onrowsdelete(const pEvtObj: IHTMLEventObj); dispid -2147418080;
procedure onrowsinserted(const pEvtObj: IHTMLEventObj); dispid -2147418079;
procedure oncellchange(const pEvtObj: IHTMLEventObj); dispid -2147418078;
procedure onpropertychange(const pEvtObj: IHTMLEventObj); dispid -2147418093;
procedure ondatasetchanged(const pEvtObj: IHTMLEventObj); dispid -2147418098;
procedure ondataavailable(const pEvtObj: IHTMLEventObj); dispid -2147418097;
procedure ondatasetcomplete(const pEvtObj: IHTMLEventObj); dispid -2147418096;
procedure onbeforeeditfocus(const pEvtObj: IHTMLEventObj); dispid 1027;
end;

具体怎么实现，参考BHO方面的内容，本方法应该是可行的，只是我没具体做过。在BHO里倒是做过。
另外你去http://www.euromind.com/iedelphi/index.htm看看，对你有帮助

这个方法到是可行，谁能够给一些详细的代码？分数不够再加。

怎么看不到回答的内容呀？？？

object Form1: TForm1
Left = 192
Top = 107
Width = 544
Height = 375
Caption = 'Form1'
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '宋体'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
PixelsPerInch = 96
TextHeight = 12
object WebBrowser1: TWebBrowser
Left = 16
Top = 16
Width = 505
Height = 249
TabOrder = 0
OnDocumentComplete = WebBrowser1DocumentComplete
ControlData = {
4C00000031340000BC1900000000000000000000000000000000000000000000
000000004C000000000000000000000001000000E0D057007335CF11AE690800
2B2E126208000000000000004C0000000114020000000000C000000000000046
8000000000000000000000000000000000000000000000000000000000000000
00000000000000000100000000000000000000000000000000000000}
end
object Button1: TButton
Left = 16
Top = 272
Width = 145
Height = 25
Caption = 'Goto cn.yahoo.com'
TabOrder = 1
OnClick = Button1Click
end
object ListBox1: TListBox
Left = 168
Top = 272
Width = 353
Height = 57
ItemHeight = 12
TabOrder = 2
end
object Edit1: TEdit
Left = 16
Top = 304
Width = 145
Height = 20
TabOrder = 3
Text = '在页面第一个编辑框输入'
end
object WebEvent1: TWebEvent
EvtSource = WebBrowser1
OnEvent = WebEvent1Event
StandardTags = 'window'
EventsToFire = 'onscroll'
WebEvents = <
item
OnEvent = WebEvent1WebEvents0Event
StandardTags = 'document'
EventsToFire = 'onmousemove'
end
item
OnEvent = WebEvent1WebEvents1Event
StandardTags = 'input'
EventsToFire = 'onkeypress'
end>
Left = 16
Top = 304
end
end


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, SHDocVw, WebEvent, MSHtml;

type
TForm1 = class(TForm)
WebEvent1: TWebEvent;
WebBrowser1: TWebBrowser;
Button1: TButton;
ListBox1: TListBox;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure WebEvent1Event(Sender: TWebBrowser; event,
SrcElement: OleVariant);
procedure WebEvent1WebEvents0Event(Sender: TWebBrowser; event,
SrcElement: OleVariant);
procedure WebEvent1WebEvents1Event(Sender: TWebBrowser; event,
SrcElement: OleVariant);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate('http://cn.yahoo.com/');
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
try
WebEvent1.AttachEvents;
except

end;
end;

procedure TForm1.WebEvent1Event(Sender: TWebBrowser; event,
SrcElement: OleVariant);
var
vDoc: OleVariant;
begin
vDoc := WebBrowser1.Document;
//Caption := IntToStr(vDoc.body.scrollLeft);
ListBox1.Items.Add('onscroll: ' + 'left-' + IntToStr(vDoc.body.scrollLeft) +
',top-' + IntToStr(vDoc.body.scrollTop));
ListBox1.ItemIndex := Pred(ListBox1.Count);
end;

procedure TForm1.WebEvent1WebEvents0Event(Sender: TWebBrowser; event,
SrcElement: OleVariant);
begin
ListBox1.Items.Add('onmousemove: ' + 'x-' + IntToStr(event.clientX) +
',y-' + IntToStr(event.clientY));
ListBox1.ItemIndex := Pred(ListBox1.Count);
end;

procedure TForm1.WebEvent1WebEvents1Event(Sender: TWebBrowser; event,
SrcElement: OleVariant);
begin
Edit1.Text := IntToStr(event.keyCode);
end;

end.

不知道为什么拦截不到input text的onchange 事件，别的事件是可以的

http://www.egroups.com/docvault/delphi-webbrowser/
这个新闻组有你要的例子，并且可以解答你很多问题。

首先谢谢大家，尤其是LiChaoHui朋友，太感谢了。分数不多，请大家笑纳。如果闲分数少的，可以到http://www.delphibbs.com/delphibbs/dispq.asp?lid=2014903 里我再给。