Ole控件的事件辅助类
2011年03月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, .TDispParams.cArgs
TEST EBX, EBX
JZ @@7
MOV ESI, .TDispParams.rgvarg
MOV EAX, EBX
SHL EAX, 4 // count * sizeof(TVarArg)
XOR EDX, EDX
ADD ESI, EAX // EDI = Params.rgvarg^
@@1: SUB ESI, 16 // Sizeof(TVarArg)
MOV EAX, dword ptr
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
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
@@5: PUSH dword ptr
@@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是一个比较轻量级的类,使用时需要手工创建和消毁,如果要更方便一点,可以写成一个组件,这样就不必关心它的生命周期了,当然代价就是多了一些体积。