Ole控件的事件辅助类

林镇群

<?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-com:office:smarttags" /><chsdate isrocdate="False" islunardate="False" day="6" month="12" year="2008" w:st="on"><span lang="EN-US"><font color="#000000" size="3">2008-12-6</font></span></chsdate>

<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" />

概述

Delphi对Ole控件作了很好的封装，使用起来要比C++的方便地多，比如想用IE控件，只需要将TWebBrowser拖到窗体上，设置相关属性，处理相关事件，一切和其他控件没有什么区别。

但是使用过程中，我们会发现一个问题，拿TWebBrowser来说，它没有OnNavigateError事件，如果我们想在连接错误的时候做一些事情，比如要用一个更漂亮的网页来代替IE预定义的错误页面，那么似乎是没有办法的了。

出现这个问题的原因是IE控件的版本，越高版本功能越多，比如错误事件是在IE 6才有的，而TWebBrowser显然是用更低版本的IE类型库生成的。解决办法之一是通过更新的类型库生成更新的控件，但这仍然不大方便，如果下一版本的IE提供了更多的事件，你就必须重新生成控件了。

我这里提供了一个更好的办法，无需要生成类型库就可以接收所有的事件。下面就是代码：

代码

(**
*OLE控件的事件辅助类
*
*bylinzhenqun<chsdate isrocdate="False" islunardate="False" day="6" month="12" year="2008" w:st="on">2008-12-6</chsdate>
*)
unitOleCtrlEventHelper;

{
用法：

1、开始时：创建TOleCtrlEventHelper，建立连接点，添加想处理的事件：
FOleCtrlEventHelper:=TOleCtrlEventHelper.Create(DIID_DWebBrowserEvents2);
FOleCtrlEventHelper.EventConnect(Webbrowser.DefaultInterface);
FOleCtrlEventHelper.AddEvent($<chmetcnv w:st="on" tcsc="0" numbertype="1" negative="False" hasspace="False" sourcevalue="10" unitname="F">10F</chmetcnv>,Method(Self,@TMyClass.OnNavigateError));

2、结束时：断开连接点，消毁TOleCtrlEventHelper
FOleCtrlEventHelper.EventDisconnect(Webbrowser.DefaultInterface);
FOleCtrlEventHelper.Free;

---linzhenqun
}

interface

uses
SysUtils,ActiveX,Classes;

type
PEventRec=^TEventRec;
TEventRec=record
DispID:TDispID;
Method:TMethod;
end;

TOleCtrlEventHelper=class(TObject,IUnknown,IDispatch)
private
FEventIID:TGUID;
FEventList:TList;
FEventsConnection:LongInt;
private
procedureClearEvent;
procedureInvokeEvent(DispID:TDispID;varParams:TDispParams);
protected
{IUnknown}
functionQueryInterface(constIID:TGUID;outObj):HResult;stdcall;
function_AddRef:Integer;stdcall;
function_Release:Integer;stdcall;
{IDispatch}
functionGetTypeInfoCount(outCount:Integer):HResult;stdcall;
functionGetTypeInfo(Index,LocaleID:Integer;outTypeInfo):HResult;stdcall;
functionGetIDsOfNames(constIID:TGUID;Names:Pointer;
NameCount,LocaleID:Integer;DispIDs:Pointer):HResult;stdcall;
functionInvoke(DispID:Integer;constIID:TGUID;LocaleID:Integer;
Flags:Word;varParams;VarResult,ExcepInfo,ArgErr:Pointer):HResult;stdcall;
public
constructorCreate(constEventIID:TGUID);
destructorDestroy;override;
functionAddEvent(DispID:TDispID;constMethod:TMethod):Boolean;
functionRemoveEvent(DispID:TDispID):Boolean;
functionGetEvent(DispID:TDispID;varMethod:TMethod):Boolean;
procedureEventConnect(Source:IInterface);
procedureEventDisconnect(Source:IInterface);
end;

functionMethod(Data,Code:Pointer):TMethod;

implementation

uses
ComObj;

functionMethod(Data,Code:Pointer):TMethod;
begin
Result.Code:=Code;
Result.Data:=Data;
end;

{TOleCtrlEventHelper}

functionTOleCtrlEventHelper.AddEvent(DispID:TDispID;constMethod:TMethod):Boolean;
var
M:TMethod;
EventRec:PEventRec;
begin
Result:=False;
ifnotGetEvent(DispID,M)then
begin
New(EventRec);
EventRec^.DispID:=DispID;
EventRec^.Method:=Method;
FEventList.Add(EventRec);
Result:=True;
end;
end;

procedureTOleCtrlEventHelper.ClearEvent;
var
i:Integer;
begin
fori:=0toFEventList.Count-1do
Dispose(FEventList.Items[i]);
FEventList.Clear;
end;

constructorTOleCtrlEventHelper.Create(constEventIID:TGUID);
begin
FEventIID:=EventIID;
FEventList:=TList.Create;
end;

destructorTOleCtrlEventHelper.Destroy;
begin
ClearEvent;
FEventList.Free;
inherited;
end;

procedureTOleCtrlEventHelper.EventConnect(Source:IInterface);
begin
InterfaceConnect(Source,FEventIID,Self,FEventsConnection);
end;

procedureTOleCtrlEventHelper.EventDisconnect(Source:IInterface);
begin
InterfaceDisconnect(Source,FEventIID,FEventsConnection);
end;

functionTOleCtrlEventHelper.GetEvent(DispID:TDispID;varMethod:TMethod):Boolean;
var
i:Integer;
EventRec:PEventRec;
begin
Result:=False;
fori:=FEventList.Count-1downto0do
begin
EventRec:=PEventRec(FEventList[i]);
ifEventRec^.DispID=DispIDthen
begin
Method:=EventRec^.Method;
Result:=True;
Break;
end;
end;
end;

functionTOleCtrlEventHelper.GetIDsOfNames(constIID:TGUID;Names:Pointer;
NameCount,LocaleID:Integer;DispIDs:Pointer):HResult;
begin
Result:=E_NOTIMPL;
end;

functionTOleCtrlEventHelper.GetTypeInfo(Index,LocaleID:Integer;
outTypeInfo):HResult;
begin
Pointer(TypeInfo):=nil;
Result:=E_NOTIMPL;
end;

functionTOleCtrlEventHelper.GetTypeInfoCount(outCount:Integer):HResult;
begin
Count:=0;
Result:=S_OK;
end;

functionTOleCtrlEventHelper.Invoke(DispID:Integer;constIID:TGUID;
LocaleID:Integer;Flags:Word;varParams;VarResult,ExcepInfo,
ArgErr:Pointer):HResult;
begin
ifnot((DispID>=DISPID_MOUSEUP)and(DispID<=DISPID_CLICK))then
InvokeEvent(DispID,TDispParams(Params));
Result:=S_OK;
end;

procedureTOleCtrlEventHelper.InvokeEvent(DispID:TDispID;
varParams:TDispParams);
var
EventMethod:TMethod;
begin
ifnotGetEvent(DispID,EventMethod)or
(Integer(EventMethod.Code)<$10000)thenExit;

//copyfromolectrls.pas:TOleControl.InvokeEvent
try
asm
PUSHEBX
PUSHESI
MOVESI,Params
MOVEBX,[ESI].TDispParams.cArgs
TESTEBX,EBX
JZ@@7
MOVESI,[ESI].TDispParams.rgvarg
MOVEAX,EBX
SHLEAX,4//count*sizeof(TVarArg)
XOREDX,EDX
ADDESI,EAX//EDI=Params.rgvarg^[ArgCount]
@@1:SUBESI,16//Sizeof(TVarArg)
MOVEAX,dwordptr[ESI]
CMPAX,varSingle//4bytestopush
JA@@3
JE@@5
@@2:TESTDL,DL
JNE@@<chmetcnv w:st="on" tcsc="0" numbertype="1" negative="False" hasspace="False" sourcevalue="2" unitname="a"><span lang="EN-US" style="FONT-SIZE: 10pt; COLOR: blue; FONT-FAMILY: 'Courier New'; mso-bidi-font-size: 12.0pt; mso-font-kerning: 0pt">2</span><span lang="EN-US" style="FONT-SIZE: 10pt; COLOR: black; FONT-FAMILY: 'Courier New'; mso-bidi-font-size: 12.0pt; mso-font-kerning: 0pt">a</span></chmetcnv>
MOVECX,ESI
INCDL
TESTEAX,varArray
JNZ@@6
MOVECX,dwordptr[ESI+8]
JMP@@6
@@<chmetcnv w:st="on" tcsc="0" numbertype="1" negative="False" hasspace="False" sourcevalue="2" unitname="a"><span lang="EN-US" style="FONT-SIZE: 10pt; COLOR: blue; FONT-FAMILY: 'Courier New'; mso-bidi-font-size: 12.0pt; mso-font-kerning: 0pt">2</span><span lang="EN-US" style="FONT-SIZE: 10pt; COLOR: black; FONT-FAMILY: 'Courier New'; mso-bidi-font-size: 12.0pt; mso-font-kerning: 0pt">a</span></chmetcnv>:TESTEAX,varArray
JZ@@5
PUSHESI
JMP@@6
@@3:CMPAX,varDate//8bytestopush
JA@@2
@@4:PUSHdwordptr[ESI+12]
@@5:PUSHdwordptr[ESI+8]
@@6:DECEBX
JNE@@1
@@7:MOVEDX,Self
MOVEAX,EventMethod.Data
CALLEventMethod.Code
POPESI
POPEBX
end;
except
end;
end;

functionTOleCtrlEventHelper.QueryInterface(constIID:TGUID;outObj):HResult;
begin
ifGetInterface(IID,Obj)then
begin
Result:=S_OK;
Exit;
end;
ifIsEqualIID(IID,FEventIID)then
begin
GetInterface(IDispatch,Obj);
Result:=S_OK;
Exit;
end;
Result:=E_NOINTERFACE;
end;

functionTOleCtrlEventHelper.RemoveEvent(DispID:TDispID):Boolean;
var
i:Integer;
EventRec:PEventRec;
begin
Result:=False;
fori:=FEventList.Count-1downto0do
begin
EventRec:=PEventRec(FEventList[i]);
ifEventRec^.DispID=DispIDthen
begin
FEventList.Remove(EventRec);
Dispose(EventRec);
Result:=True;
Break;
end;
end;
end;

functionTOleCtrlEventHelper._AddRef:Integer;
begin
Result:=-1;
end;

functionTOleCtrlEventHelper._Release:Integer;f