计算机控件类,计算机二级DELPHI控件:Ole控件的事件辅助类

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[i]);

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[i]);

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]

计算机二级DELPHI控件:Ole控件的事件辅助类.doc

下载Word文档到电脑，方便收藏和打印[全文共3381字]

编辑推荐：

下载Word文档