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;
18 FOnClick: TDocumentContextMenuEvent;
19 FOnMouseMove: TDocumentContextMenuEvent;
20 FOnMouseDown: TDocumentContextMenuEvent;
21 FOnDoubleClick: TDocumentContextMenuEvent;
24 function QueryInterface(const IID:TGUID; out Obj): HRESULT; stdcall;
25 function _AddRef:Integer; stdcall;
26 function _Release:Integer; stdcall;
28 function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall;
29 function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT; stdcall;
30 function GetIDsOfNames(const IID: TGUID; Names: Pointer;
31 NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall;
32 function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
33 Flags: Word; var Params; VarResult, ExcepInfo, ArgErr:Pointer): HRESULT; stdcall;
35 constructor Create(AOwner: TObject; ADisp: IDispatch; const AIID: TGUID);
36 destructor Destroy; override;
37 property OnContextMenu: TDocumentContextMenuEvent read FOnContextMenu write FOnContextMenu;
38 property OnClick: TDocumentContextMenuEvent read FOnClick write FOnClick;
39 property OnMouseMove: TDocumentContextMenuEvent read FOnMouseMove write FOnMouseMove;
40 property OnMouseDown: TDocumentContextMenuEvent read FOnMouseDown write FOnMouseDown;
41 property OnDoubleClick: TDocumentContextMenuEvent read FOnDoubleClick write FOnDoubleClick;
46 function THTMLDocumentEventSink._AddRef: Integer;
51 function THTMLDocumentEventSink._Release: Integer;
56 constructor THTMLDocumentEventSink.Create(AOwner: TObject; ADisp: IDispatch; const AIID: TGUID);
62 InterfaceConnect(FSimpleDisp, FSimpleIID, Self, FSimpleCon);
65 destructor THTMLDocumentEventSink.Destroy;
67 InterfaceDisconnect(FSimpleDisp,FSimpleIID,FSimpleCon);
71 function THTMLDocumentEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
72 NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT;
77 function THTMLDocumentEventSink.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT;
82 function THTMLDocumentEventSink.GetTypeInfoCount(out Count: Integer): HRESULT;
88 function THTMLDocumentEventSink.Invoke(DispID: Integer; const IID: TGUID;
89 LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
90 ArgErr: Pointer): HRESULT;
94 if Assigned(FOnMouseDown) then begin
95 PVariant(VarResult)^ := FOnMouseDown(FOwner);
98 if Assigned(FOnMouseMove) then begin
99 PVariant(VarResult)^ := FOnMouseMove(FOwner);
102 if Assigned(FOnClick) then begin
103 PVariant(VarResult)^ := FOnClick(FOwner);
106 if Assigned(FOnDoubleClick) then begin
107 PVariant(VarResult)^ := FOnDoubleClick(FOwner);
110 if Assigned(FOnContextMenu) then begin
111 PVariant(VarResult)^ := FOnContextMenu(FOwner);
117 function THTMLDocumentEventSink.QueryInterface(const IID: TGUID; out Obj): HRESULT;
119 Result := E_NOINTERFACE;
120 if GetInterface(IID,Obj) then
122 if IsEqualGUID(IID,FSimpleIID) and GetInterface(IDispatch,Obj) then