|
概述 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是一個比較輕量級的類，使用時需要手工創建和消毀，如果要更方便一點，可以寫成一個組件，這樣就不必關心它的生命周期了，當然代價就是多了一些體積。 |
