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

问题描述 投票：0回答：1

简短版本

使用嵌入在 Delphi 中的 

TWebBrowser
，用户必须单击超链接两次才能使其注册单击：

  • 第一次点击就被吃掉了
  • 第二次点击实际上是由浏览器注册的

如何阻止第一次点击被吃掉？

长版

我们有一个 TWebBrowser（或者 TEmbeddedWB，如果您喜欢改进的控件），它为 Delphi 表单上的部分用户界面提供支持。嵌入的 HTML 中有超链接，使用 Javascript 在 Delphi 中显示：

<A href="javascript:window.external.FrobTheGrobber">

这会调用浏览器的标准 

IDispatch
接口。首先，它使用标准 IDispatch.GetIDsOfNames 执行方法名称到 
dispid
的后期绑定：

function TfrmGrobber.wbTasksGetIDsOfNames(const IID: TGUID;
  Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT;
var
    oslNames: POleStrList;
    pdidDispIds: PDispIDList;
begin
    OslNames := Names;
    pdidDispIDs := DispIds;
    if SameText(oslNames[0], 'FrobTheGrobber') then
    begin
        pdidDispIDs[0] := DISPID_FrobTheGrobber;
        Result := S_OK;
    end
end;

并且它使用 dispid:

 调用标准
IDispatch.Invoke

function TfrmGrobber.wbTasksInvoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params: tagDISPPARAMS; VarResult,
  ExcepInfo, ArgErr: Pointer): HRESULT;
begin
    case DispId of
    DISPID_FrobTheGrobber: 
       begin
            //...here we frob the grobber
            Result := S_OK;
        end;
    end;
end;

这一切都有效。

这有点管用

当用户点击 

<A>
超链接时，第一次点击总是被吃掉——什么也没有发生。用户认为他们疯了，他们再次点击它，然后它就起作用了。

23 年前就一直这样了。

我真的想修复它。

研究工作

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

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

他有意见要解释：

源自

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

为了避免包含 OleCtrls 单元（其中包括 Variants），这将允许测试 

TOleControl
类，
IOleClientSite
接口用于测试，这是受支持的通过 
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;

这正是我遇到的问题。我不明白他在说什么，但他说得很有权威，而且显然这很有效。问题是该解决方法对我不起作用。老实说，我不知道问题到底是什么，以及他的解决方案如何解决它。

包装非 VCL 的解决方法 控件（如 TWebBrowser），它可以 不使用VCL机制并保留 ActiveControl 属性错误 状态，这会导致麻烦时 控制重心重新调整。每个控制 从 TOleControl 派生有 可能是焦点问题。

对于其他类，不应修改活动控件。
否则，您需要单击两次才能选择它。

（强调我的）

有没有人：

  • 知道他的评论是什么意思
  • 或者理解他在说什么
  • 可以解释问题是什么
  • 他的修复应该如何修复它

代码达到了预期的效果：

Form.ActiveControl := nil;

但这并没有起到作用。

我会修复它，但我不知道他是如何找到它的，也不知道 TOleControl 不“使用 VCL 机制并使 ActiveControl 属性处于错误状态。”

我知道所有这些词各自的含义，但按顺序我不知道它们在说什么。

奖励阅读

我最初问这个问题 

borland.public.delphi.nativeapi.win32
2008 年新闻组

Soft-Gems 论坛上的问题

delphi focus ole delphi-xe6 twebbrowser
1个回答
3
投票

我通过使用 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;
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.