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是一个比较轻量级的类，使用时需要手工创建和消毁，如果要更方便一点，可以写成一个组件，这样就不必关心它的生命周期了，当然代价就是多了一些体积。

Ole控件的事件辅助类

网友评论

厂商推荐