Момент нажатия ссылки в WebBrowser e

← →
smok_er (2002-10-15 14:57) [0]

Мастера!
Помогите пожалуйста с сабжем.
Событие beforeNavigate не подходит, т.к. вызывается несколько раз во время загрузки документа, например если в нем есть фреймы.
А нужно отловить событие начала загрузки документа...

Заранее огромное спасибо!

← →
int64 © (2002-10-16 03:04) [1]

Если проблема только во фреймах, то можно в beforeNavigate проверять:

if TargetFrameName<>"" then {то, что хотел выполнить}

Хотя, имхо, надо ещё подумать и о зарезервированых именах фреймов (_blank, _self, ...). Не будет ли здесь граблей.

Если ничего не поможет, тогда уже ловить клики.

← →
smok_er (2002-10-16 03:23) [2]

Вот и хотелось бы узнать, как их отлавливать...
Можете дать кусок исходника?

← →
int64 © (2002-10-16 04:07) [3]

Подключение к событиям объектной модели DHTML:

http://rsdn.ru/article/default.asp?inet/dhtmlspy.xml

Правда на Сях. Может под Д переведу (только не сегодня) - покажу. А не переведу - не покажу.

← →
smok_er (2002-10-16 22:47) [4]

Спасибо! Но лучше конечно это увидеть на родном и близком к сердцу делфи :) Если будет время, переведите пожалуйста.

Ну нет, статью переводить не буду. Вопервых, не благодарное занятие; вовторых перевод с языка на язык это даже не вольная интерпретация - надо заново статью писать. Втретьих, если уж очень интересует механизм ConnectionPoint, то видел когда-то статью на http://community.borland.com. Точной ссылки не помню.

Вот ещё вариант набросал, как к событиям подключаться. Сам доработаешь.
Я ловлю события линков onclick и onmousemove. Можно все элементы на один объект натянуть, т.н. группой обслуживать. А можно на каждый линк свой объект создавать.

....

TDocEvent = class(TObject, IUnknown, IDispatch)
private
FRefCount: Integer;
FEventDisp: IDispatch;
FName: 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;
procedure SetName(const Value: string);
public
constructor Create(AName: string; event: OleVariant);
property Name: string read FName write SetName;
end;

var
Form1: TForm1;
DocEventClick, DocEventMouseMove: TDocEvent;
implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate("c:\temp\events.htm");
end;

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(AName: string; event: OleVariant);
begin
inherited Create;
FName:= AName;
if not VarIsNull(event) then
FEventDisp := IDispatch(event);
end;

procedure TDocEvent.SetName(const Value: string);
begin
FName := Value;
end;

function TDocEvent.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params;
VarResult, ExcepInfo, ArgErr: Pointer): HResult;
begin
try
if Name="DocEventClick" then
MessageDlg("DocEventClick", mtinformation, [mbok], 0);
if Name="DocEventMouseMove" then
Form1.Caption:= TimeTostr(Time);
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
vA, vDoc, vColl: OleVariant;
i: integer;
begin
vDoc := WebBrowser1.Document;
vColl := vDoc.Links;// или то, что надо
for i := 0 to vColl.length - 1 do
begin
va:= vColl.item(i);
DocEventClick:=TDocEvent.Create("DocEventClick", vA.onclick);
vA.onclick := OleVariant(DocEventClick as IDispatch);
DocEventMouseMove:=TDocEvent.Create("DocEventMouseMove", vA.onMouseMove);
vA.onMouseMove := OleVariant(DocEventMouseMove as IDispatch);
end;
end;

end.

Идея, в принципе, понятна. Дерзай.

Момент нажатия ссылки в WebBrowser e Найти похожие ветки