Delphi：TOleControl将ActiveControl置于错误的状态？

Question

在Mike Lischke的Virtual Treeview中，有解决方法代码 添加以修复在同一表单上使用 TWebBrowser 控件时的错误。

问题在于，如果用户尝试与 TOleControl （ TWebBrowser 下降）进行交互，则会第一次点击鼠标。然后他们必须再次单击以给出控件焦点。 然后他们可以与控件互动。

他有意见解释：

  

从TOleControl派生的每个控件都可能成为焦点问题。

     

为了避免包含 OleCtrls 单元（其中包括 Variants ），这将允许测试TOleControl类， IOleClientSite接口用于测试，由TOleControl支持，是一个很好的指标。

从完整的snippit：

procedure TBaseVirtualTree.WMKillFocus(var Msg: TWMKillFocus);
var
  Form: TCustomForm;
  Control: TWinControl;
  Pos: TSmallPoint;
  Unknown: IUnknown;
begin
  inherited;

  [snip]

  {
    Workaround for wrapped non-VCL controls (like TWebBrowser), 
    which do not use VCL mechanisms and 
    leave the ActiveControl property in the wrong state, 
    which causes trouble when the control is refocused.
  }
  Form := GetParentForm(Self);
  if Assigned(Form) and (Form.ActiveControl = Self) then
  begin
    Cardinal(Pos) := GetMessagePos;
    Control := FindVCLWindow(SmallPointToPoint(Pos));
    {
      Every control derived from TOleControl has potentially 
      the focus problem. In order to avoid including 
      the OleCtrls unit (which will, among others, include Variants),  
      which would allow to test for the TOleControl
      class, the IOleClientSite interface is used for the test, 
      which is supported by TOleControl and a good indicator.
    }
    if Assigned(Control) and Control.GetInterface(IOleClientSite, Unknown) then
      Form.ActiveControl := nil;

    // For other classes the active control should not be modified. Otherwise you need two clicks to select it.
  end;
end;

问题是解决方法不再适用于我。说实话，我不知道问题究竟是什么，以及他的解决方案如何修复它。

是否有人知道他的评论是什么理解他正在谈论的内容，可以解释问题是什么，以及他正在做什么应该修复它？

  

包装非VCL的解决方法   控件（如TWebBrowser），这样做   不使用VCL机制并离开   ActiveControl属性错了   状态，这会导致麻烦   控制重新聚焦。每一个控制   派生自TOleControl   可能是焦点问题。

代码已达到预期的

Form.ActiveControl := nil; 

声明，但它只是没有做到这一点。

我会修复它，但我不知道他是如何找到它的，或者它是如何产生的 TOleControl 不会“使用VCL机制并将ActiveControl属性保留在错误的状态。“

---

奖金阅读

我最初问过这个问题on borland.public.delphi.nativeapi.win32 newsgroup in 2008

Question on Soft-Gems forum

Bump 20110515 （12个月后）

Bump 20150401 （7年后）：在XE6中仍无效

Answer 1

我已经通过使用TEmbeddedWB（比标准的TWebBrowser好得多）克服了这个问题，然后我不得不添加这个OnShowUI事件：

function THtmlFrame.webBrowserShowUI(const dwID: Cardinal;
  const pActiveObject: IOleInPlaceActiveObject;
  const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
  const pDoc: IOleInPlaceUIWindow): HRESULT;
begin
  try
    if WebBrowser.CanFocus then
      WebBrowser.SetFocus; // tell the VCL that the web-browser is focused
  except
    on E: EInvalidOperation do
      ; // ignore "Cannot focus inactive or invisible control"
  end;
  Result := S_FALSE;
end;

但是如果必须使用TWebBrowser，则需要编写更多代码：

type
  IDocHostUIHandler = interface(IUnknown)
    ['{bd3f23c0-d43e-11cf-893b-00aa00bdce1a}']
    function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
      const CommandTarget: IUnknown; const Context: IDispatch): HRESULT; stdcall;
    function GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT; stdcall;
    function ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject;
      const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
      const pDoc: IOleInPlaceUIWindow): HRESULT; stdcall;
    function HideUI: HRESULT; stdcall;
    function UpdateUI: HRESULT; stdcall;
    function EnableModeless(const fEnable: BOOL): HRESULT; stdcall;
    function OnDocWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
    function OnFrameWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
    function ResizeBorder(const prcBorder: PRECT; const pUIWindow: IOleInPlaceUIWindow; const fRameWindow: BOOL): HRESULT; stdcall;
    function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID; const nCmdID: DWORD): HRESULT; stdcall;
    function GetOptionKeyPath(out pchKey: POLESTR; const dw: DWORD): HRESULT; stdcall;
    function GetDropTarget(const pDropTarget: IDropTarget; out ppDropTarget: IDropTarget): HRESULT; stdcall;
    function GetExternal(out ppDispatch: IDispatch): HRESULT; stdcall;
    function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR; out ppchURLOut: POLESTR): HRESULT; stdcall;
    function FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HRESULT; stdcall;
  end; // IDocHostUIHandler

  ICustomDoc = interface(IUnknown)
    ['{3050f3f0-98b5-11cf-bb82-00aa00bdce0b}']
    function SetUIHandler(const pUIHandler: IDocHostUIHandler): HResult; stdcall;
  end;

  TDocHostUIHandler = class(TInterfacedObject, IDocHostUIHandler)
  private
    FWebBrowser: TWebBrowser;
  protected
    function EnableModeless(const fEnable: BOOL): HResult; stdcall;
    function FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HResult; stdcall;
    function GetDropTarget(const pDropTarget: IDropTarget; out ppDropTarget: IDropTarget): HResult; stdcall;
    function GetExternal(out ppDispatch: IDispatch): HResult; stdcall;
    function GetHostInfo(var pInfo: TDocHostUIInfo): HResult; stdcall;
    function GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD): HResult; stdcall;
    function HideUI: HResult; stdcall;
    function OnDocWindowActivate(const fActivate: BOOL): HResult; stdcall;
    function OnFrameWindowActivate(const fActivate: BOOL): HResult; stdcall;
    function ResizeBorder(const prcBorder: PRECT; const pUIWindow: IOleInPlaceUIWindow;
      const fFrameWindow: BOOL): HResult; stdcall;
    function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
      const pcmdtReserved: IInterface; const pdispReserved: IDispatch): HResult; stdcall;
    function ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject;
      const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
      const pDoc: IOleInPlaceUIWindow): HResult; stdcall;
    function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID; const nCmdID: DWORD): HResult; stdcall;
    function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR; var ppchURLOut: POLESTR): HResult; stdcall;
    function UpdateUI: HResult; stdcall;
  public
    constructor Create(AWebBrowser: TWebBrowser);
    property WebBrowser: TWebBrowser read FWebBrowser;
  end;


{ TDocHostUIHandler }

function TDocHostUIHandler.EnableModeless(const fEnable: BOOL): HResult;
begin
  Result := S_OK;
end;

function TDocHostUIHandler.FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HResult;
begin
  ppDORet := nil;
  Result := S_FALSE;
end;

function TDocHostUIHandler.GetDropTarget(const pDropTarget: IDropTarget; out ppDropTarget: IDropTarget): HResult;
begin
  ppDropTarget := nil;
  Result := E_FAIL;
end;

function TDocHostUIHandler.GetExternal(out ppDispatch: IDispatch): HResult;
begin
  ppDispatch := nil;
  Result := E_FAIL;
end;

function TDocHostUIHandler.GetHostInfo(var pInfo: TDocHostUIInfo): HResult;
begin
  Result := S_OK;
end;

function TDocHostUIHandler.GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD): HResult;
begin
  Result := E_FAIL;
end;

function TDocHostUIHandler.HideUI: HResult;
begin
  Result := S_OK;
end;

function TDocHostUIHandler.OnDocWindowActivate(const fActivate: BOOL): HResult;
begin
  Result := S_OK;
end;

function TDocHostUIHandler.OnFrameWindowActivate(const fActivate: BOOL): HResult;
begin
  Result := S_OK;
end;

function TDocHostUIHandler.ResizeBorder(const prcBorder: PRECT; const pUIWindow: IOleInPlaceUIWindow; const fFrameWindow: BOOL): HResult;
begin
  Result := S_FALSE;
end;

function TDocHostUIHandler.ShowContextMenu(const dwID: DWORD; const ppt: PPOINT; const pcmdtReserved: IInterface; const pdispReserved: IDispatch): HResult;
begin
  Result := S_FALSE
end;

function TDocHostUIHandler.TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID; const nCmdID: DWORD): HResult;
begin
  Result := S_FALSE;
end;

function TDocHostUIHandler.TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR; var ppchURLOut: POLESTR): HResult;
begin
  Result := E_FAIL;
end;

function TDocHostUIHandler.UpdateUI: HResult;
begin
  Result := S_OK;
end;

function TDocHostUIHandler.ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject; const pCommandTarget: IOleCommandTarget;
  const pFrame: IOleInPlaceFrame; const pDoc: IOleInPlaceUIWindow): HResult;
begin
  try
    if WebBrowser.CanFocus then
      WebBrowser.SetFocus; // tell the VCL that the web-browser is focused
  except
    on E: EInvalidOperation do
      ; // ignore "Cannot focus inactive or invisible control"
  end;
  Result := S_OK;
end;



// install the DocHostUIHandler into the WebBrowser
var
  CustomDoc: ICustomDoc;
begin
  if WebBrowser1.Document.QueryInterface(ICustomDoc, CustomDoc) = S_OK then
    CustomDoc.SetUIHandler(TDocHostUIHandler.Create(WebBrowser1));
end;