Ole控件的事件辅助类
发布时间:2011-3-29 20:24
发布者:1770309616
概述 Delphi对Ole控件作了很好的封装,使用起来要比C++的方便地多,比如想用IE控件,只需要将TWebBrowser拖到窗体上,设置相关属性,处理相关事件,一切和其他控件没有什么区别。 但是使用过程中,我们会发现一个问题,拿TWebBrowser来说,它没有OnNavigateError事件,如果我们想在连接错误的时候做一些事情,比如要用一个更漂亮的网页来代替IE预定义的错误页面,那么似乎是没有办法的了。 出现这个问题的原因是IE控件的版本,越高版本功能越多,比如错误事件是在IE 6才有的,而TWebBrowser显然是用更低版本的IE类型库生成的。解决办法之一是通过更新的类型库生成更新的控件,但这仍然不大方便,如果下一版本的IE提供了更多的事件,你就必须重新生成控件了。 我这里提供了一个更好的办法,无需要生成类型库就可以接收所有的事件。下面就是代码: 代码 (** * OLE控件的事件辅助类 * * by linzhenqun 2008-12-6 *) unit OleCtrlEventHelper; { 用法: 1、开始时:创建TOleCtrlEventHelper,建立连接点,添加想处理的事件: FOleCtrlEventHelper := TOleCtrlEventHelper.Create(DIID_DWebBrowserEvents2); FOleCtrlEventHelper.EventConnect(Webbrowser.DefaultInterface); FOleCtrlEventHelper.AddEvent($10F, 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 procedure ClearEvent; procedure InvokeEvent(DispID: TDispID; var Params: TDispParams); protected { IUnknown } function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; function _AddRef: Integer; stdcall; function _Release: Integer; stdcall; { IDispatch } 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 EventIID: TGUID); destructor Destroy; override; function AddEvent(DispID: TDispID; const Method: TMethod): Boolean; function RemoveEvent(DispID: TDispID): Boolean; function GetEvent(DispID: TDispID; var Method: TMethod): Boolean; procedure EventConnect(Source: IInterface); procedure EventDisconnect(Source: IInterface); end; function Method(Data, Code: Pointer): TMethod; implementation uses ComObj; function Method(Data, Code: Pointer): TMethod; begin Result.Code := Code; Result.Data := Data; end; { TOleCtrlEventHelper } function TOleCtrlEventHelper.AddEvent(DispID: TDispID; const Method: TMethod): Boolean; var M: TMethod; EventRec: PEventRec; begin Result := False; if not GetEvent(DispID, M) then begin New(EventRec); EventRec^.DispID := DispID; EventRec^.Method := Method; FEventList.Add(EventRec); Result := True; end; end; procedure TOleCtrlEventHelper.ClearEvent; var i: Integer; begin for i := 0 to FEventList.Count - 1 do Dispose(FEventList.Items); FEventList.Clear; end; constructor TOleCtrlEventHelper.Create(const EventIID: TGUID); begin FEventIID := EventIID; FEventList := TList.Create; end; destructor TOleCtrlEventHelper.Destroy; begin ClearEvent; FEventList.Free; inherited; end; procedure TOleCtrlEventHelper.EventConnect(Source: IInterface); begin InterfaceConnect(Source, FEventIID, Self, FEventsConnection); end; procedure TOleCtrlEventHelper.EventDisconnect(Source: IInterface); begin InterfaceDisconnect(Source, FEventIID, FEventsConnection); end; function TOleCtrlEventHelper.GetEvent(DispID: TDispID; var Method: TMethod): Boolean; var i: Integer; EventRec: PEventRec; begin Result := False; for i := FEventList.Count - 1 downto 0 do begin EventRec := PEventRec(FEventList); if EventRec^.DispID = DispID then begin Method := EventRec^.Method; Result := True; Break; end; end; end; function TOleCtrlEventHelper.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; begin Result := E_NOTIMPL; end; function TOleCtrlEventHelper.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; begin Pointer(TypeInfo) := nil; Result := E_NOTIMPL; end; function TOleCtrlEventHelper.GetTypeInfoCount(out Count: Integer): HResult; begin Count := 0; Result := S_OK; end; function TOleCtrlEventHelper.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; begin if not ((DispID >= DISPID_MOUSEUP) and (DispID <= DISPID_CLICK)) then InvokeEvent(DispID, TDispParams(Params)); Result := S_OK; end; procedure TOleCtrlEventHelper.InvokeEvent(DispID: TDispID; var Params: TDispParams); var EventMethod: TMethod; begin if not GetEvent(DispID, EventMethod) or (Integer(EventMethod.Code) < $10000) then Exit; // copy from olectrls.pas: TOleControl.InvokeEvent try asm PUSH EBX PUSH ESI MOV ESI, Params MOV EBX, [ESI].TDispParams.cArgs TEST EBX, EBX JZ @@7 MOV ESI, [ESI].TDispParams.rgvarg MOV EAX, EBX SHL EAX, 4 // count * sizeof(TVarArg) XOR EDX, EDX ADD ESI, EAX // EDI = Params.rgvarg^[ArgCount] @@1: SUB ESI, 16 // Sizeof(TVarArg) MOV EAX, dword ptr [ESI] CMP AX, varSingle // 4 bytes to push JA @@3 JE @@5 @@2: TEST DL,DL JNE @@2a MOV ECX, ESI INC DL TEST EAX, varArray JNZ @@6 MOV ECX, dword ptr [ESI+8] JMP @@6 @@2a: TEST EAX, varArray JZ @@5 PUSH ESI JMP @@6 @@3: CMP AX, varDate // 8 bytes to push JA @@2 @@4: PUSH dword ptr [ESI+12] @@5: PUSH dword ptr [ESI+8] @@6: DEC EBX JNE @@1 @@7: MOV EDX, Self MOV EAX, EventMethod.Data CALL EventMethod.Code POP ESI POP EBX end; except end; end; function TOleCtrlEventHelper.QueryInterface(const IID: TGUID; out Obj): HResult; begin if GetInterface(IID, Obj) then begin Result := S_OK; Exit; end; if IsEqualIID(IID, FEventIID) then begin GetInterface(IDispatch, Obj); Result := S_OK; Exit; end; Result := E_NOINTERFACE; end; function TOleCtrlEventHelper.RemoveEvent(DispID: TDispID): Boolean; var i: Integer; EventRec: PEventRec; begin Result := False; for i := FEventList.Count - 1 downto 0 do begin EventRec := PEventRec(FEventList); if EventRec^.DispID = DispID then begin FEventList.Remove(EventRec); Dispose(EventRec); Result := True; Break; end; end; end; function TOleCtrlEventHelper._AddRef: Integer; begin Result := -1; end; function TOleCtrlEventHelper._Release: Integer; begin Result := -1; end; end. 用法 使用方法非常简单,我写了一个Demo传上来,可以从下面连接下载: http://download.csdn.net/source/843895 TOleCtrlEventHelper是一个比较轻量级的类,使用时需要手工创建和消毁,如果要更方便一点,可以写成一个组件,这样就不必关心它的生命周期了,当然代价就是多了一些体积。 |
网友评论