Delphi: TOleControl переводит ActiveControl в неправильное состояние?

В Virtual Treeview Майка Лишке был добавлен обходной код для исправления ошибки при использовании < strong>TVWebBrowser в той же форме.

Проблема заключалась в том, что если пользователь пытается взаимодействовать с TOleControl (от которого происходит TWebBrowser), первый щелчок мыши съедается. Затем они должны щелкнуть еще раз, чтобы передать фокус управления. Затем они могут взаимодействовать с элементом управления.

У него есть комментарии, чтобы объяснить:

Каждый элемент управления, производный от TOleControl, потенциально имеет проблему с фокусом.

Во избежание включения модуля OleCtrls (в который, среди прочего, будут включены Варианты), который позволил бы протестировать класс TOleControl, для класса TOleControl используется интерфейс IOleClientSite. test, который поддерживается 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

Поднять 20110515 (12 месяцев спустя)

Bump 20150401 (7 лет спустя): по-прежнему не работает в XE6.

Bump 20210309 (11 лет спустя)


focus delphi ole delphi-xe6 twebbrowser
person Ian Boyd    schedule 13.05.2009    source источник
comment
Является ли Virtual TreeView несуществующим. Последняя версия от 14 марта 09? Вероятно, лучший компонент Delphi, ИМХО.   -  person Tom    schedule 13.05.2009
comment
Он был несуществующим, когда я впервые задал вопрос. Когда Майк перешел к разработке для Mac и MySQL, это не очень хорошо для VT. Есть некоторая спорадическая поддержка, но ничего официального.   -  person Ian Boyd    schedule 13.05.2009
comment
При изменении этого вопроса для использования некоторых существующих тегов я обнаружил, что тег tvirtualtreeview уже существует в этом вопросе: stackoverflow.com/questions/687438 . Вам лучше знать, какой из них правильный, поэтому не могли бы вы изменить один из них? Спасибо.   -  person Michael Myers    schedule 14.05.2009
comment
Сам Майк называет этот продукт Virtual Treeview, и если вы поищете в Google запросы virtualtreeview и tvirtualtreeview, вы найдете гораздо больше записей для первого. Поэтому я изменил тег другого вопроса с tvirtualtreeview на virtualtreeview.   -  person lkessler    schedule 14.05.2009
comment
Последняя версия VirtualTreeview 4.8.5 не работает в Delphi 2009, и на их форумах нет указаний на то, что кто-то занимается этим.   -  person lkessler    schedule 14.05.2009
comment
не работает в Delphi 2009. А чем я тогда пользуюсь в данный момент? Код со звезд? 4.8.5 работает. Даже 4.7.0 работает с Delphi 2009.   -  person Andreas Hausladen    schedule 14.05.2009
comment
Официальный сайт и форумы мертвы. Что-то менее официальное смотрите здесь: delphipraxis.net/ (на немецком языке).   -  person Uli Gerhardt    schedule 14.05.2009
comment
Означает ли обновление от 16 марта 2009 г., что веб-сайт мертв? soft-gems.net/   -  person Andreas Hausladen    schedule 14.05.2009
comment
Я хотел сказать, что нет центрального места для обсуждения разработки (как Mantis). Обсуждение происходит, например. в Delphi-Praxis. Извините за путаницу.   -  person Uli Gerhardt    schedule 14.05.2009

Ответы (1)


arrow_upward
3
arrow_downward

Я преодолел эту проблему, используя 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;
person Andreas Hausladen    schedule 14.05.2009
comment
я использую TEmbeddedWB, но проблема также возникает с TWebBrowser - и я бы не хотел, чтобы люди уходили по касательной, обвиняя TEmbeddedWB. я пытался добавить CanFocus/SetFocus в событие OnShowUI - не работает. Главным образом потому, что событие OnShowUI на самом деле не запускается, пока я не нажму на элемент управления веб-браузером. - person Ian Boyd; 14.05.2009