Форум: "Сети";
Текущий архив: 2004.03.28;
Скачать: [xml.tar.bz2];

Вниз

TWebBrowser Как в BeforeNavigate2 отличить загрузку очередного   Найти похожие ветки 

← →
Кен ©   (2004-01-08 01:27) [0]

фрейма от клика пользователя по ссылке ?
TargetFrameName - может быть любой. Flags почему то всегда нулевой. Свойств онМаусДаун у ВебБраузера нету. Бред какой то. Почему в Майкрософт всё решили свалить в одну кучу, и фреймы и клики пользователя ? Как отличить одно от другого ?

---

← →
Кен ©   (2004-01-08 01:29) [1]

Два раза запостилось случайно.

---

← →
int64   (2004-01-08 09:52) [2]

Свойств онМаусДаун у ВебБраузера есть, только из Delphi к ним достучаться не просто.

---

← →
Кен ©   (2004-01-09 01:47) [3]

> int64   (08.01.04 09:52) [2]
> Свойств онМаусДаун у ВебБраузера есть, только из Delphi
> к ним достучаться не просто.

А как тогда это сделать ?

---

← →
int64   (2004-01-09 12:33) [4]

Вот код, который клик по документу ловит:

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;
 DocClick: 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="DocClick" then
  begin
   MessageDlg("DocClick", 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: IHTMLDocument2;
begin
 vDoc := WebBrowser1.Document as IHTMLDocument2;
 DocClick:=TDocEvent.Create("DocClick", vDoc.onclick);
 vDoc.onclick := OleVariant(DocClick as IDispatch);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 WebBrowser1.Navigate("C:\temp\index.htm");
end;

Под линки сам оптимизируй.

Но этот метод крироват и не удобен.
Есть более уневерсальный на RSDN была статья, правда под С++.
Для Delpi не видел. Вприципе, если здесь полазить:
http://www.techvanguards.com/
понятнее будет.

---

← →
easy ©   (2004-01-09 13:23) [5]

вот так ещё можно..

unit Unit1;

interface

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

type
 TPageHTMLEventSink = class(TComponent, IDispatch)
 private
   FDocument: OleVariant;
 public
   constructor Create(AOwner: Tcomponent; theDocument: OleVariant);
   destructor Destroy; override;
   function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
     Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer):
     HResult; stdcall;
 end;

type
 TForm1 = class(TForm)
   WebBrowser1: TWebBrowser;
   procedure WebBrowser1DocumentComplete(Sender: TObject;
     const pDisp: IDispatch; var URL: OleVariant);
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

constructor TPageHTMLEventSink.Create(AOwner: Tcomponent; theDocument: OleVariant);
begin
 FDocument := theDocument;
 FDocument.attachEvent("onclick", IDispatch(Self));
end;

destructor TPageHTMLEventSink.Destroy;
begin
 FDocument.detachEvent("onclick", IDispatch(Self));
 inherited;
end;

function TPageHTMLEventSink.Invoke(DispID: Integer; const IID: TGUID;
 LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
 ArgErr: Pointer): HResult;
var
 Element: Olevariant;
begin
 if lowercase(FDocument.parentWindow.event.type) = "click" then begin
   Element := FDocument.parentWindow.event.srcElement;
   form1.Caption := Element.tagName;
   (*
   form1.Caption:=Element.id;
   form1.Caption:=Element.outerHTML;
   form1.Caption:=Element.outerText;*)
   FDocument.parentWindow.event.cancelBubble := true;
   FDocument.parentWindow.event.returnValue := false;
 end;
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
 const pDisp: IDispatch; var URL: OleVariant);
var
 i: integer;
begin
 if WebBrowser1.OleObject.document.frames.length > 0 then
   for i := 0 to WebBrowser1.OleObject.document.frames.length - 1 do
     TPageHTMLEventSink.Create(self, WebBrowser1.OleObject.document.frames.item(i).document);
 TPageHTMLEventSink.Create(self, WebBrowser1.OleObject.document);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 WebBrowser1.Navigate("www.microsoft.com");
end;

end.

---

← →
Кен ©   (2004-01-11 03:03) [6]

О Боже мой ! Как же всё это сложно то.

---

Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2004.03.28;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.035 c