delphi - WebBrowser SinkEvents 和 DesignMode = 'on'

Question

Zarko Gajic 在以下文章和演示中演示了如何在鼠标移到 TWebBrowser 文档上时获取超链接的 url：http://delphi.about.com/od/vclusing/a/wbsinkevents.htm 此 演示运行良好，直到WebBrowser 设置为 designmode = 'on'，则不会执行 OnMouseMove 事件。是否可以增强演示以便在 DesignMode = 'on' 时执行 OnMouseMove 事件？如果没有，是否有不同的方法来创建 Document.OnMouseMove 事件？我正在使用德尔福 2010。

[编辑]请求更多代码，所以这里是实现

procedure TForm1.DesignMode1Click( Sender: TObject );
var
  iDocument: MSHTML.IHTMLDocument2;
begin
  if Assigned( WebBrowser1 ) then
  begin
    iDocument := htmlDoc; //( WebBrowser1.Document as IHTMLDocument2 );
    if Assigned( iDocument ) then
    begin
      if DesignMode1.Checked then
        iDocument.DesignMode := 'On'
      else
        iDocument.DesignMode := 'Off';
      WebBrowser1.Refresh2;
    end;
  end;
end;

procedure TForm1.Document_OnMouseOver;
var
  element: IHTMLElement;
begin
  if htmlDoc = nil then
    Exit;

  element := htmlDoc.parentWindow.event.srcElement;

  elementInfo.Clear;

  if LowerCase( element.tagName ) = 'a' then
  begin
    elementInfo.Lines.Add( 'LINK info...' );
    elementInfo.Lines.Add( Format( 'HREF : %s', [ element.getAttribute( 'href', 0 ) ] ) );
  end
  else if LowerCase( element.tagName ) = 'img' then
  begin
    elementInfo.Lines.Add( 'IMAGE info...' );
    elementInfo.Lines.Add( Format( 'SRC : %s', [ element.getAttribute( 'src', 0 ) ] ) );
  end
  else
  begin
    elementInfo.Lines.Add( Format( 'TAG : %s', [ element.tagName ] ) );
  end;
end; (* Document_OnMouseOver *)

procedure TForm1.FormCreate( Sender: TObject );
begin
  WebBrowser1.Navigate( 'http://delphi.about.com' );
  elementInfo.Clear;
  elementInfo.Lines.Add( 'Move your mouse over the document...' );
end; (* FormCreate *)

procedure TForm1.WebBrowser1BeforeNavigate2( ASender: TObject; const pDisp: IDispatch;
  var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool );
begin
  htmlDoc := nil;
end; (* WebBrowser1BeforeNavigate2 *)

procedure TForm1.WebBrowser1DocumentComplete( ASender: TObject; const pDisp: IDispatch; var URL: OleVariant );

begin
  if Assigned( WebBrowser1.Document ) then
  begin
    htmlDoc := WebBrowser1.Document as IHTMLDocument2;
    htmlDoc.onmouseover := ( TEventObject.Create( Document_OnMouseOver ) as IDispatch );
  end;
end; (* WebBrowser1DocumentComplete *)

{ TEventObject }

constructor TEventObject.Create( const OnEvent: TObjectProcedure );
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;

end.

[修复] 我发现在将 webbrowser 设置为设计模式后没有执行 WebBrowser1DocumentComplete，所以我更改了 DesignMode1Click 并解决了问题。我发布了这个，所以其他人也可以看到这个：

procedure TForm1.DesignMode1Click( Sender: TObject );
begin
  // the following is unsafe because you may click on the
  // check box even if you don't have any page navigated
  -- htmlDoc := WebBrowser1.Document as IHTMLDocument2;

  // htmlDoc will be assigned from the OnDocumentComplete
  // fired by Navigate procedure
  if Assigned( htmlDoc ) then
  begin
    if DesignMode1.Checked then
      htmlDoc.DesignMode := 'On'
    else
      htmlDoc.DesignMode := 'Off';

    // switching to design mode takes some time and if there 
    // are some pages which doesn't fire OnDocumentComplete 
    // event when you are switching to design mode, like
    // http://delphi.about.com do, then I would wait for 
    // web browser to be ready
    while WebBrowser1.ReadyState < READYSTATE_COMPLETE do
      Application.ProcessMessages;

    // release the previous "document instance"
    htmlDoc := nil;
    // assign the new one and attach the event
    htmlDoc := WebBrowser1.Document as IHTMLDocument2;
    htmlDoc.OnMouseOver := ( TEventObject.Create( Document_OnMouseOver ) as IDispatch );
  end;
end;