Sub AddEmotion(strUrl)
On Error Resume Next
set cpAdder = CreateObject("QQCPHelper.CPAdder")
if 0 = err then
call cpAdder.AddCustomEmotion(strUrl)
end if
end sub
Sub OnContextMenu()
set srcEvent = external.menuArguments.event
set EventElement = external.menuArguments.document.elementFromPoint(srcEvent.clientX, srcEvent.clientY)
if "HTMLImg" = TypeName(EventElement) then
Call AddEmotion(EventElement.href)
end if
end sub
call OnContextMenu()
</script>
上面的关键是: if "HTMLImg" = TypeName(EventElement) then,判断当前右击的是否图像
procedure DoDocumentComplete(IEHELP: TIEBrowserHelper; const pDisp: IDispatch;
var URL: OleVariant);
var
we: IWebBrowser2;
doc: OleVariant;
i: Integer;
obj: IHTMLObjectElement;
em2: IHTMLElement2;
begin
we := pDisp as IWebBrowser2;
if we = nil then
exit;
doc := we.Document as IHTMLDocument2;
//这里判断Flash对象的方法比较粗简,可以优化
for i := 0 to doc.all.length - 1 do
begin
if Supports(doc.all.item(i), IID_IHTMLObjectElement, obj) then
begin
if sametext(obj.classid, 'clsid:D27CDB6E-AE6D-11cf-96B8-444553540000')
then
begin
//关联Flash对象的鼠标移入,移出事件
em2 := obj as IHTMLElement2;
em2.attachEvent('onmouseout', IEHELP.MouseOutSink);
em2.attachEvent('onmouseover', IEHELP.MouseOverSink);
end;
end;
end;
end;
procedure DoOnQuit;
begin
end;
procedure DoOnVisible(Visible: WordBool);
begin
end;
procedure DoOnToolBar(ToolBar: WordBool);
begin
end;
procedure DoOnMenuBar(MenuBar: WordBool);
begin
end;
procedure DoOnStatusBar(StatusBar: WordBool);
begin
end;
procedure DoOnFullScreen(FullScreen: WordBool);
begin
end;
procedure DoOnTheaterMode(TheaterMode: WordBool);
begin
end;
procedure DoWindowSetResizable(Resizable: WordBool);
begin
end;
procedure DoWindowSetLeft(Left: Integer);
begin
end;
procedure DoWindowSetTop(Top: Integer);
begin
end;
procedure DoWindowSetWidth(Width: Integer);
begin
end;
procedure DoWindowSetHeight(Height: Integer);
begin
end;
procedure DoWindowClosing(IsChildWindow: WordBool; var Cancel: WordBool);
begin
end;
procedure DoClientToHostWindow(var CX: Integer; var CY: Integer);
begin
end;
procedure DoSetSecureLockIcon(SecureLockIcon: Integer);
begin
end;
procedure DoFileDownload(var Cancel: WordBool);
begin
end;
procedure BuildPositionalDispIds(pDispIds: PDispIdList; const dps: TDispParams);
var
i: integer;
begin
Assert(pDispIds <> nil);
for i := 0 to dps.cArgs - 1 do
pDispIds^[i] := dps.cArgs - 1 - i;
if (dps.cNamedArgs <= 0) then
Exit;
for i := 0 to dps.cNamedArgs - 1 do
pDispIds^[dps.rgdispidNamedArgs^[i]] := i;
end;
function TIEBrowserHelper.Invoke(DispID: Integer; const IID: TGUID; LocaleID:
Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
type
POleVariant = ^OleVariant;
var
dps: TDispParams absolute Params;
bHasParams: boolean;
pDispIds: PDispIdList;
iDispIdsSize: integer;
begin
pDispIds := nil;
iDispIdsSize := 0;
bHasParams := (dps.cArgs > 0);
if (bHasParams) then
begin
iDispIdsSize := dps.cArgs * SizeOf(TDispId);
GetMem(pDispIds, iDispIdsSize);
end;
try
if (bHasParams) then
BuildPositionalDispIds(pDispIds, dps);
Result := S_OK;
case DispId of
DISPID_STATUSTEXTCHANGE:
DoStatusTextChange(dps.rgvarg^[pDispIds^[0]].bstrval);
DISPID_PROGRESSCHANGE: DoProgressChange(dps.rgvarg^[pDispIds^[0]].lval,
dps.rgvarg^[pDispIds^[1]].lval);
DISPID_COMMANDSTATECHANGE:
DoCommandStateChange(dps.rgvarg^[pDispIds^[0]].lval,
dps.rgvarg^[pDispIds^[1]].vbool);
DISPID_DOWNLOADBEGIN: DoDownloadBegin();
DISPID_DOWNLOADCOMPLETE: DoDownloadComplete();
DISPID_TITLECHANGE: DoTitleChange(dps.rgvarg^[pDispIds^[0]].bstrval);
DISPID_PROPERTYCHANGE:
DoPropertyChange(dps.rgvarg^[pDispIds^[0]].bstrval);
DISPID_BEFORENAVIGATE2:
DoBeforeNavigate2(IDispatch(dps.rgvarg^[pDispIds^[0]].dispval),
POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^,
POleVariant(dps.rgvarg^[pDispIds^[2]].pvarval)^,
POleVariant(dps.rgvarg^[pDispIds^[3]].pvarval)^,
POleVariant(dps.rgvarg^[pDispIds^[4]].pvarval)^,
POleVariant(dps.rgvarg^[pDispIds^[5]].pvarval)^,
dps.rgvarg^[pDispIds^[6]].pbool^);
DISPID_NEWWINDOW2:
DoNewWindow2(IDispatch(dps.rgvarg^[pDispIds^[0]].pdispval^),
dps.rgvarg^[pDispIds^[1]].pbool^);
DISPID_NAVIGATECOMPLETE2:
DoNavigateComplete2(IDispatch(dps.rgvarg^[pDispIds^[0]].dispval),
POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^);
DISPID_DOCUMENTCOMPLETE: DoDocumentComplete(self,
IDispatch(dps.rgvarg^[pDispIds^[0]].dispval),
POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^);
DISPID_ONVISIBLE: DoOnVisible(dps.rgvarg^[pDispIds^[0]].vbool);
DISPID_ONTOOLBAR: DoOnToolBar(dps.rgvarg^[pDispIds^[0]].vbool);
DISPID_ONMENUBAR: DoOnMenuBar(dps.rgvarg^[pDispIds^[0]].vbool);
DISPID_ONSTATUSBAR: DoOnStatusBar(dps.rgvarg^[pDispIds^[0]].vbool);
DISPID_ONFULLSCREEN: DoOnFullScreen(dps.rgvarg^[pDispIds^[0]].vbool);
DISPID_ONTHEATERMODE: DoOnTheaterMode(dps.rgvarg^[pDispIds^[0]].vbool);
DISPID_WINDOWSETRESIZABLE:
DoWindowSetResizable(dps.rgvarg^[pDispIds^[0]].vbool);
DISPID_WINDOWCLOSING: DoWindowClosing(dps.rgvarg^[pDispIds^[0]].vbool,
dps.rgvarg^[pDispIds^[1]].pbool^);
DISPID_WINDOWSETLEFT: DoWindowSetLeft(dps.rgvarg^[pDispIds^[0]].lval);
DISPID_WINDOWSETTOP: DoWindowSetTop(dps.rgvarg^[pDispIds^[0]].lval);
DISPID_WINDOWSETWIDTH: DoWindowSetWidth(dps.rgvarg^[pDispIds^[0]].lval);
DISPID_WINDOWSETHEIGHT: DoWindowSetHeight(dps.rgvarg^[pDispIds^[0]].lval);
DISPID_CLIENTTOHOSTWINDOW:
DoClientToHostWindow(dps.rgvarg^[pDispIds^[0]].plval^,
dps.rgvarg^[pDispIds^[1]].plval^);
DISPID_SETSECURELOCKICON:
DoSetSecureLockIcon(dps.rgvarg^[pDispIds^[0]].lval);
DISPID_FILEDOWNLOAD: DoFileDownload(dps.rgvarg^[pDispIds^[0]].pbool^);
DISPID_ONQUIT:
begin
DoOnQuit();
CP.Unadvise(Cookie);
end;
else
Result := DISP_E_MEMBERNOTFOUND;
end;
finally
if (bHasParams) then
FreeMem(pDispIds, iDispIdsSize);
end;
end;
//procedure BuildPositionalDispIds and function Invoke
//is created using EventSinkImp, written by Binh Ly (bly@castle.net)
//You can download EventSinkImp from: http://www.techvanguard.com/
DISPID_BEFORENAVIGATE = 100;
// this is sent before navigation to give a chance to abort
DISPID_NAVIGATECOMPLETE = 101;
// in async, this is sent when we have enough to show
DISPID_STATUSTEXTCHANGE = 102;
DISPID_QUIT = 103;
DISPID_DOWNLOADCOMPLETE = 104;
DISPID_COMMANDSTATECHANGE = 105;
DISPID_DOWNLOADBEGIN = 106;
DISPID_NEWWINDOW = 107; // sent when a new window should be created
DISPID_PROGRESSCHANGE = 108; // sent when download progress is updated
DISPID_WINDOWMOVE = 109; // sent when main window has been moved
DISPID_WINDOWRESIZE = 110; // sent when main window has been sized
DISPID_WINDOWACTIVATE = 111; // sent when main window has been activated
DISPID_PROPERTYCHANGE = 112; // sent when the PutProperty method is called
DISPID_TITLECHANGE = 113; // sent when the document title changes
DISPID_TITLEICONCHANGE = 114;
// sent when the top level window icon may have changed.
DISPID_FRAMEBEFORENAVIGATE = 200;
DISPID_FRAMENAVIGATECOMPLETE = 201;
DISPID_FRAMENEWWINDOW = 204;
DISPID_BEFORENAVIGATE2 = 250; // hyperlink clicked on
DISPID_NEWWINDOW2 = 251;
DISPID_NAVIGATECOMPLETE2 = 252; // UIActivate new document
DISPID_ONQUIT = 253;
DISPID_ONVISIBLE = 254; // sent when the window goes visible/hidden
DISPID_ONTOOLBAR = 255; // sent when the toolbar should be shown/hidden
DISPID_ONMENUBAR = 256; // sent when the menubar should be shown/hidden
DISPID_ONSTATUSBAR = 257; // sent when the statusbar should be shown/hidden
DISPID_ONFULLSCREEN = 258; // sent when kiosk mode should be on/off
DISPID_DOCUMENTCOMPLETE = 259; // new document goes ReadyState_Complete
DISPID_ONTHEATERMODE = 260; // sent when theater mode should be on/off
DISPID_ONADDRESSBAR = 261; // sent when the address bar should be shown/hidden
DISPID_WINDOWSETRESIZABLE = 262;
// sent to set the style of the host window frame
DISPID_WINDOWCLOSING = 263;
// sent before script window.close closes the window
DISPID_WINDOWSETLEFT = 264;
// sent when the put_left method is called on the WebOC
DISPID_WINDOWSETTOP = 265;
// sent when the put_top method is called on the WebOC
DISPID_WINDOWSETWIDTH = 266;
// sent when the put_width method is called on the WebOC
DISPID_WINDOWSETHEIGHT = 267;
// sent when the put_height method is called on the WebOC
DISPID_CLIENTTOHOSTWINDOW = 268;
// sent during window.open to request conversion of dimensions
DISPID_SETSECURELOCKICON = 269;
// sent to suggest the appropriate security icon to show
DISPID_FILEDOWNLOAD = 270;
// Fired to indicate the File Download dialog is opening
type
//鼠标移出事件处理
TMouseOutSink = class(TInterfacedObject, iDispatch)
private
Fie: IWebbrowser2;
public
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;
end;
//鼠标移入事件处理
TMouseOverSink = class(TInterfacedObject, iDispatch)
private
Fie: IWebbrowser2;
public
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;
end;
procedure DoDownloadBegin;
begin
//HelperForm.Memo1.Lines.Add('Download Begin');
end;
procedure DoDownloadComplete;
begin
//HelperForm.Memo1.Lines.Add('Download Complete');
end;
procedure DoTitleChange(const Text: WideString);
begin
//HelperForm.Memo1.Lines.Add('TitleChange: ' + TEXT);
end;
procedure DoPropertyChange(const szProperty: WideString);
begin
//HelperForm.Memo1.Lines.Add('PropertyChange: ' + szProperty);
end;
procedure DoBeforeNavigate2(const pDisp: IDispatch; var URL: OleVariant; var
Flags: OleVariant; var TargetFrameName: OleVariant; var PostData: OleVariant; var
Headers: OleVariant; var Cancel: WordBool);
begin
end;
procedure DoNewWindow2(var ppDisp: IDispatch; var Cancel: WordBool);
begin
end;
procedure DoNavigateComplete2(const pDisp: IDispatch; var URL: OleVariant);
begin