2009-12-07 70 views
0

我使用這個代碼TEventObject與IE瀏覽器的標籤頁爲致命錯誤

try 
    document := (pDisp as IWebbrowser2).Document AS IHTMLDocument2; 
    Body := Document.body; 
    Links := Document.links; 
    for i := 0 to (Links.length-1) do 
    begin 
     tmp := (Links.item(i, 0) as IHTMLElement); 
     tmp.onclick := TEventObject.Create(MyProcedure) as IDispatch; // THIS LINE 
    end; 
    except 
    on E : Exception do 
     ShowMessage(E.ClassName+' error raised, with message : '+E.Message); 
    end; 

在IE網頁瀏覽器的DocumentComplete事件,它工作正常,但是當我打開一個新標籤,我得到一個Microsoft Internet Explorer遇到一個問題,需要關閉」的錯誤。

標記在上面的代碼//這行的行是導致它的人(我評論它,它並沒有顯示錯誤)。

以下是其餘代碼:

TEventObject = class(TInterfacedObject, IDispatch) 
    private 
    FOnEvent: TProcedure; 
    protected 
    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 OnEvent: TProcedure); 
    property OnEvent: TProcedure read FOnEvent write FOnEvent; 
    end; 


........... 

constructor TEventObject.Create(const OnEvent: TProcedure); 
begin 
    inherited Create; 
    FOnEvent := OnEvent; 
end; 

function TEventObject.GetIDsOfNames(const IID: TGUID; Names: Pointer; 
    NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; 
begin 
    Result := E_NOTIMPL; 
end; 

function TEventObject.GetTypeInfo(Index, LocaleID: Integer; 
    out TypeInfo): HResult; 
begin 
    Result := E_NOTIMPL; 
end; 

function TEventObject.GetTypeInfoCount(out Count: Integer): HResult; 
begin 
    Result := E_NOTIMPL; 
end; 

function TEventObject.Invoke(DispID: Integer; const IID: TGUID; 
    LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, 
    ArgErr: Pointer): HResult; 
begin 
    if (Dispid = DISPID_VALUE) then 
    begin 
    if Assigned(FOnEvent) then 
     FOnEvent; 
    Result := S_OK; 
    end 
    else Result := E_NOTIMPL; 
end; 

我怎樣才能使它適用於標籤?

回答

1

我找到了一個解決辦法:

URL := AnsiLowerCase(URL); 
    if (URL='') or (URL='about:blank') or (URL='about:tabs') then Exit; 

單擊事件工作正常別人的網頁是不是:標籤。