这并不是对您的问题的完整答案,但希望能帮助您完成大部分工作。
(对于通过类似的 q 到达这里的未来读者:
假设您有一个用于自动化/Com 服务器的类型库导入单元,例如 SHDocVw、MSHTML 或 MS Word 的类型库导入单元。有时,Delphi 的类型库导入器会向它生成的 Delphi TObject 后代包装器添加事件支持,例如 TWebBrowser、OnNavigateComplete 等的事件。其他时候,它不能或不会生成 Delphi 包装器类,但您仍然可以附加通过多种方法之一连接到服务器对象事件,例如通过创建如下所示的 EventObject,它连接服务器对象的事件和 Delphi 代码中的事件处理程序。
处理接口事件基本上涉及定义一个实现 IDispatch 接口的 Delphi 类,然后将该接口连接到您想要通知其事件的 Ole 或 COM 对象。然后,当接口“后面”的 Ole/COM 中发生事件时,它会像您调用 IDispatch 一样调用 IDispatch。您对事件通知的处理完全取决于您;下面的代码将它们传递给 TForm1 的方法。
)
下面的 EventObject 与 TeamB 的 Deborah Pate 于 2003 年 11 月在 Borland NG 上发布的事件密切相关(她的网站上有一个关于使用 Delphi 进行自动化的非常好的部分 -http://www.djpate.freeserve.co.uk/Automation.htm http://www.djpate.freeserve.co.uk/Automation.htm)。该对象非常通用,因为它不限于处理任何特定 Ole/COM 对象的事件。
// The following code is intended to illustrate methods of detecting that the
// active element in an Html page has changed. See the comments in the AnEvent
// procedure about how exactly to detect such a change.
//
// The code also illustrates how to handle a single event, e.g. onbeforeeditfocus
// of an Events objects such as HtmlDocumentEvents or HtmlDocumentEvents2 (see MSHTML.Pas)
// or all the events the events interface contains.
type
TInvokeEvent = procedure(Sender : TObject; DispIP : Integer) of Object;
TEventObject = class(TInterfacedObject, IDispatch)
private
FOnEvent: TInvokeEvent;
FSinkAllEvents : Boolean;
protected
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(const AnEvent : TInvokeEvent; SinkAll : Boolean);
property OnEvent: TInvokeEvent read FOnEvent write FOnEvent;
property SinkAllEvents: Boolean read FSinkAllEvents;
end;
type
TForm1 = class(TForm)
[ ... ]
private
{ Private declarations }
procedure AnEvent(Sender : TObject; DispID : Integer);
procedure AnotherEvent(Sender : TObject; DispID : Integer);
public
{ Public declarations }
Doc : IHtmlDocument3;
DocEvent,
DocEvent2: OleVariant;
Cookie : Longint;
CPC : IConnectionPointContainer;
Sink : IConnectionPoint;
PrvActiveElement : IHTMLElement;
Events : Integer;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
constructor TEventObject.Create(const AnEvent: TInvokeEvent; SinkAll : Boolean);
begin
inherited Create;
FOnEvent := AnEvent;
FSinkAllEvents := SinkAll;
end;
function TEventObject.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;
function TEventObject.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
Result := E_NOTIMPL;
end;
function TEventObject.GetTypeInfoCount(out Count: Integer): HResult;
begin
Result := E_NOTIMPL;
end;
function TEventObject.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
begin
if SinkAllEvents then begin
if Assigned(FOnEvent) then
FOnEvent(Self, DispID);
Result := S_OK;
end
else begin
if (Dispid = DISPID_VALUE) then begin
if Assigned(FOnEvent) then
FOnEvent(Self, DispID);
Result := S_OK;
end
else Result := E_NOTIMPL;
end;
end;
procedure TForm1.AnEvent(Sender : TObject; DispID : Integer);
var
Doc2 : IHTMLDocument2;
E : IHTMLElement;
begin
Inc(Events);
Doc.QueryInterface(IHTMLDocument2, Doc2);
E := Doc2.activeElement;
// NB: When an <INPUT> text edit is receiving focus, the following code is triggered twice
// or more with different values of Pointer(Doc2.activeElement). So, "(E <> PrvActiveElement)"
// doesn't seem a very effective test that the active element has changed. However,
// testing E's Name, ID, etc should provide a useful test.
if (E <> Nil) and (E <> PrvActiveElement) and E.isTextEdit then begin
if PrvActiveElement <> Nil then
PrvActiveElement := E;
Caption := Format('Something happened: Element Tagname: %s, Name: %s, %d, %d, %p',
[E.TagName, E.GetAttribute('Name', 0), DispID, Events, Pointer(Doc2.activeElement)]);
end;
end;
procedure TForm1.AnotherEvent(Sender : TObject; DispID : Integer);
begin
Caption := Format('Something else happened: %d', [DispID]);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Lines.LoadFromFile('D:\aaad7\html\postdata.htm');
end;
procedure TForm1.btnLoadClick(Sender: TObject);
var
V : OleVariant;
Doc2 : IHtmlDocument2;
begin
WebBrowser1.Navigate('about:blank');
Doc := WebBrowser1.Document as IHTMLDocument3;
Doc.QueryInterface(IHTMLDocument2, Doc2);
V := VarArrayCreate([0, 0], varVariant);
V[0] := Memo1.Lines.Text;
try
Doc2.Write(PSafeArray(TVarData(v).VArray));
finally
Doc2.Close;
end;
DocEvent := TEventObject.Create(Self.AnEvent, cbSinkAll.Checked) as IDispatch;
if cbsinkAll.Checked then begin
CPC := Doc2 as IConnectionPointContainer;
Assert(CPC <> Nil);
OleCheck(CPC.FindConnectionPoint(HTMLDocumentEvents, Sink));
OleCheck((Sink as IConnectionPoint).Advise(DocEvent, Cookie));
end
else
Doc.onbeforeeditfocus := DocEvent;
end;
请注意 TForm1.AnEvent 中的注释。如果您选中 cbSinkAll 复选框
并在具有多个 INPUT 框的页面上运行代码,您会注意到 AnEvent 在进入sameINPUT 框,每次使用不同的 Doc2.ActiveElement 值。我不确定为什么会这样,但这确实意味着比较当前的
具有先前值的 Doc2.ActiveElement 属性的值无法有效检测更改
焦点集中在 Html 页面上。但是,比较元素的属性,例如它的名称或 ID 似乎确实提供了可靠的检查。
两个注意事项:
- 在 Deborah Pate 的原始代码中,她将先前的事件处理程序(如果有)保存到 OleVariant 中,以便稍后可以恢复。
- 如果你想连续连接几个Html页面的事件,你应该释放中间的EventObject。
[摘自 MSHTML.Pas]
HTMLDocumentEvents = dispinterface
['{3050F260-98B5-11CF-BB82-00AA00BDCE0B}']
function onhelp: WordBool; dispid -2147418102;
[...]
procedure onbeforeeditfocus; dispid 1027;
end;