Delphi:TOleControl将ActiveControl置于错误状态？

在Mike Lischke的作品中，有变通代码 添加以修复在同一窗体上使用TWebBrowser控件时出现的错误

问题是，如果用户试图与TOleControl（TWebBrowser从其下降）交互，第一次鼠标点击就会被吃掉。然后，它们必须再次单击以获得控制焦点然后它们可以与控件交互

他有评论要解释：

从

TOleControl

派生的每个控件都有潜在的焦点问题

为了避免包含允许测试

TOleControl

类的OleCtrls单元（其中将包括变体），测试使用

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属性位于错误的位置 状态，当 控制重新聚焦。每个控件 源自托莱康特罗 潜在的焦点问题

代码正在达到预期的目标

Form.ActiveControl := nil; 

声明，但它只是不做的把戏

我会修复它，但我不知道他是如何发现它的，也不知道它是如何导致TOleControl没有“使用VCL机制并使ActiveControl属性处于错误状态”的

---

额外阅读 我最初问这个问题

Bump 20110515（12个月后）

Bump 20150401（7年后）：在XE6中仍然不起作用

---

Bump 20210309（11年后）

我通过使用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;

---

虚拟树视图已经失效。最新版本从14。火星09号？可能是IMHO有史以来最伟大的Delphi组件。当我第一次问这个问题时，它已经失效了。当Mike转到Mac和MySQL开发时，VT看起来不太好。有一些零星的支持，但没有正式的支持。当重新标记此问题以使用一些现有标记时，我发现tvirtualtreeview标记已经存在于此问题中：。你会更清楚哪个是正确的，所以你介意换一个吗？谢谢。迈克自己把这个产品称为虚拟树视图，如果你在谷歌上搜索virtualtreeview和tvirtualtreeview，你会发现更多关于前者的条目。因此，我已将另一个问题的标签从tvirtualtreeview更改为virtualtreeview。virtualtreeview的最新版本4.8.5在Delphi 2009中不起作用，并且在他们的论坛中没有任何迹象表明是否有人在关注此问题。我使用的是TEmbeddedWB，但问题也发生在TWebBrowser身上——我不希望人们因为指责TEmbeddedWB而偏离正轨。我尝试将CanFocus/SetFocus添加到OnShowUI事件-不起作用。主要是因为OnShowUI事件在我单击web浏览器控件之前不会被触发。