Delphi對(duì)Ole控件作了很好的封裝，使用起來(lái)要比C++的方便地多，比如想用IE控件，只需要將TWebBrowser拖到窗體上，設(shè)置相關(guān)屬性，處理相關(guān)事件，一切和其他控件沒(méi)有什么區(qū)別。
但是使用過(guò)程中，我們會(huì)發(fā)現(xiàn)一個(gè)問(wèn)題，拿TWebBrowser來(lái)說(shuō)，它沒(méi)有OnNavigateError事件，如果我們想在連接錯(cuò)誤的時(shí)候做一些事情，比如要用一個(gè)更漂亮的網(wǎng)頁(yè)來(lái)代替IE預(yù)定義的錯(cuò)誤頁(yè)面，那么似乎是沒(méi)有辦法的了。
出現(xiàn)這個(gè)問(wèn)題的原因是IE控件的版本，越高版本功能越多，比如錯(cuò)誤事件是在IE 6才有的，而TWebBrowser顯然是用更低版本的IE類型庫(kù)生成的。解決辦法之一是通過(guò)更新的類型庫(kù)生成更新的控件，但這仍然不大方便，如果下一版本的IE提供了更多的事件，你就必須重新生成控件了。
考試大這里提供了一個(gè)更好的辦法，無(wú)需要生成類型庫(kù)就可以接收所有的事件。下面就是代碼：
代碼
(**
* OLE控件的事件輔助類
*
* by linzhenqun 2008-12-6
*)
unit OleCtrlEventHelper;
{
用法：
1、開(kāi)始時(shí)：創(chuàng)建TOleCtrlEventHelper，建立連接點(diǎn)，添加想處理的事件：
FOleCtrlEventHelper := TOleCtrlEventHelper.Create(DIID_DWebBrowserEvents2);
FOleCtrlEventHelper.EventConnect(Webbrowser.DefaultInterface);
FOleCtrlEventHelper.AddEvent($10F, Method(Self, @TMyClass.OnNavigateError));
2、結(jié)束時(shí)：斷開(kāi)連接點(diǎn)，消毀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]
但是使用過(guò)程中，我們會(huì)發(fā)現(xiàn)一個(gè)問(wèn)題，拿TWebBrowser來(lái)說(shuō)，它沒(méi)有OnNavigateError事件，如果我們想在連接錯(cuò)誤的時(shí)候做一些事情，比如要用一個(gè)更漂亮的網(wǎng)頁(yè)來(lái)代替IE預(yù)定義的錯(cuò)誤頁(yè)面，那么似乎是沒(méi)有辦法的了。
出現(xiàn)這個(gè)問(wèn)題的原因是IE控件的版本，越高版本功能越多，比如錯(cuò)誤事件是在IE 6才有的，而TWebBrowser顯然是用更低版本的IE類型庫(kù)生成的。解決辦法之一是通過(guò)更新的類型庫(kù)生成更新的控件，但這仍然不大方便，如果下一版本的IE提供了更多的事件，你就必須重新生成控件了。
考試大這里提供了一個(gè)更好的辦法，無(wú)需要生成類型庫(kù)就可以接收所有的事件。下面就是代碼：
代碼
(**
* OLE控件的事件輔助類
*
* by linzhenqun 2008-12-6
*)
unit OleCtrlEventHelper;
{
用法：
1、開(kāi)始時(shí)：創(chuàng)建TOleCtrlEventHelper，建立連接點(diǎn)，添加想處理的事件：
FOleCtrlEventHelper := TOleCtrlEventHelper.Create(DIID_DWebBrowserEvents2);
FOleCtrlEventHelper.EventConnect(Webbrowser.DefaultInterface);
FOleCtrlEventHelper.AddEvent($10F, Method(Self, @TMyClass.OnNavigateError));
2、結(jié)束時(shí)：斷開(kāi)連接點(diǎn)，消毀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]