1 unit HTMLDocumentEvent;
6 Windows, Classes, ActiveX, ComObj;
9 TDocumentContextMenuEvent = function(Sender: TObject): WordBool of object;
11 THTMLDocumentEventSink = class(TInterfacedObject,IUnknown,IDispatch)
14 FSimpleDisp: IDispatch;
17 FOnContextMenu: TDocumentContextMenuEvent;
20 function QueryInterface(const IID:TGUID; out Obj): HRESULT; stdcall;
21 function _AddRef:Integer; stdcall;
22 function _Release:Integer; stdcall;
24 function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall;
25 function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT; stdcall;
26 function GetIDsOfNames(const IID: TGUID; Names: Pointer;
27 NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall;
28 function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
29 Flags: Word; var Params; VarResult, ExcepInfo, ArgErr:Pointer): HRESULT; stdcall;
31 constructor Create(AOwner: TObject; ADisp: IDispatch; const AIID: TGUID);
32 destructor Destroy; override;
33 property OnContextMenu: TDocumentContextMenuEvent read FOnContextMenu write FOnContextMenu;
38 function THTMLDocumentEventSink._AddRef: Integer;
43 function THTMLDocumentEventSink._Release: Integer;
48 constructor THTMLDocumentEventSink.Create(AOwner: TObject; ADisp: IDispatch; const AIID: TGUID);
54 InterfaceConnect(FSimpleDisp, FSimpleIID, Self, FSimpleCon);
57 destructor THTMLDocumentEventSink.Destroy;
59 InterfaceDisconnect(FSimpleDisp,FSimpleIID,FSimpleCon);
63 function THTMLDocumentEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
64 NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT;
69 function THTMLDocumentEventSink.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT;
74 function THTMLDocumentEventSink.GetTypeInfoCount(out Count: Integer): HRESULT;
80 function THTMLDocumentEventSink.Invoke(DispID: Integer; const IID: TGUID;
81 LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
82 ArgErr: Pointer): HRESULT;
86 if Assigned(FOnContextMenu) then begin
87 PVariant(VarResult)^ := FOnContextMenu(FOwner);
93 function THTMLDocumentEventSink.QueryInterface(const IID: TGUID; out Obj): HRESULT;
95 Result := E_NOINTERFACE;
96 if GetInterface(IID,Obj) then
98 if IsEqualGUID(IID,FSimpleIID) and GetInterface(IDispatch,Obj) then