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

Posted 2023-02-23

【中文标题】Delphi：TOleControl 将 ActiveControl 置于错误状态？

【英文标题】：Delphi: TOleControl puts ActiveControl in wrong state?

【发布时间】：2010-10-25 22:47:54

【问题描述】：

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

问题在于，如果用户尝试与 TOleControl（TWebBrowser 下降的）交互，则第一次鼠标点击会被吃掉。然后他们必须再次单击以赋予控制焦点。 然后他们可以与控件交互。

他有cmets要解释：

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

为了避免包含 OleCtrls 单元（其中将包含 Variants），这将允许测试TOleControl 类，@测试使用987654327@接口，TOleControl支持，指标不错。

摘自全文：

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;

问题是解决方法不再适合我。老实说，我不知道问题到底是什么，也不知道他的解决方案是如何解决的。

有没有人知道他的 cmets 明白他在说什么，可以解释问题是什么，以及他应该如何解决问题？

包装的非 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 中仍然不起作用

Bump 20210309（11 年后）

【问题讨论】：

虚拟 TreeView 已失效。 14. mars 09 的最新版本？恕我直言，可能是有史以来最伟大的 Delphi 组件。

当我第一次问这个问题时它已经失效了。当 Mike 转向 Mac 和 mysql 开发时，VT 看起来并不好。有一些零星的支持，但没有官方支持。

在重新标记这个问题以使用一些现有标签时，我发现这个问题中已经存在 tvirtualtreeview 标签：***.com/questions/687438。你会更好地知道哪个是正确的，所以你介意改变其中一个吗？谢谢。

Mike 自己将产品称为 Virtual Treeview，如果您在 Google 上搜索 virtualtreeview 和 tvirtualtreeview，您会发现更多关于前者的条目。所以我将另一个问题的标签从 tvirtualtreeview 更改为 virtualtreeview。

VirtualTreeview 的最新版本 4.8.5 在 Delphi 2009 中不起作用，并且在他们的论坛中没有任何迹象表明是否有人正在研究这个。

【参考方案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;

【讨论】：

我正在使用 TEmbeddedWB，但问题也发生在 TWebBrowser 上——我不希望人们直接指责 TEmbeddedWB。我尝试将 CanFocus/SetFocus 添加到 OnShowUI 事件 - 不起作用。主要是因为在我单击 Web 浏览器控件之前，OnShowUI 事件实际上并没有被触发。