Как поймать клик мыши по TWebBrowser?

← →
Provodnick (2003-04-02 08:50) [0]

Здравствуйте, уважаемые эксперты. Проблема в том, что надо создать как бы OnClick для TWebBrowser (насколько я знаю, такого в его событиях нет). Почему-то, когда в TWebBrowser открыта какая-нибудь страничка, то сообщения идут уже не по хендлу TWebBrowser-а, а по какому-то другому (точнее, другим - их почему-то два!?!). Подскажите пожалуйста, как решить проблему.

← →
Provodnick (2003-04-02 13:49) [1]

Неужели ни у кого никаких идей!?! Не верю я в это...

← →
Provodnick (2003-04-02 21:17) [2]

Всё ещё не верю...

← →
int64 (2003-04-02 23:08) [3]

Вот, лови идею:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Variants, StdCtrls, ComObj, OleCtrls, SHDocVw;type

TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
procedure WebBrowser1DocumentComplete(Sender: TObject; pDisp: IDispatch;
var URL: OleVariant);
procedure FormCreate(Sender: TObject);
end;

TDocEvent = class(TObject, IUnknown, IDispatch)
private
FRefCount: Integer;
FEventDisp: IDispatch;
FParam: string;
{ 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
constructor Create(AParam: string; event: OleVariant);
end;

var
Form1: TForm1;
DocEventClick: TDocEvent;
implementation

{$R *.DFM}

function TDocEvent.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;

function TDocEvent._AddRef: Integer;
begin
Inc(FRefCount);
Result := FRefCount;
end;

function TDocEvent._Release: Integer;
begin
Dec(FRefCount);
Result := FRefCount;
end;

function TDocEvent.GetTypeInfoCount(out Count: Integer): HResult;
begin
if FEventDisp <> nil then
Result := FEventDisp.GetTypeInfoCount(Count)
else begin
Count := 0;
Result := S_OK;
end;
end;

function TDocEvent.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 TDocEvent.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;

constructor TDocEvent.Create(AParam: string; event: OleVariant);
begin
inherited Create;
FParam:= AParam;
if not VarIsNull(event) then
FEventDisp := IDispatch(event);
end;

function TDocEvent.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params;
VarResult, ExcepInfo, ArgErr: Pointer): HResult;
var vA, vDoc, vColl: OleVariant;
begin
try
if FParam="DocEventClick" then
begin
MessageDlg("DocEventClick", mtinformation, [mbok], 0);
end;
except
//
end;
if FEventDisp <> nil then
begin
Result := FEventDisp.Invoke(DispID, IID, LocaleID, Flags, Params,
VarResult, ExcepInfo, ArgErr);
end else
Result := E_NOTIMPL;
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject; pDisp: IDispatch;
var URL: OleVariant);
var
vDoc: OleVariant;
begin
vDoc := WebBrowser1.Document;
DocEventClick:=TDocEvent.Create("DocEventClick", vDoc.onclick);
vDoc.onclick := OleVariant(DocEventClick as IDispatch);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate("about:<h1>Click my!</h1>");
end;

end.

← →
Provodnick (2003-04-03 17:24) [4]

int64, Большое Человеческое Спасибо.

Как поймать клик мыши по TWebBrowser? Найти похожие ветки