Delphi: TOleControl menempatkan ActiveControl dalam kondisi yang salah?

Dalam Virtual Treeview Mike Lischke, ada kode solusi yang ditambahkan untuk memperbaiki bug saat menggunakan < kontrol kuat>TWebBrowser pada formulir yang sama.

Masalahnya adalah jika pengguna mencoba berinteraksi dengan TOleControl (yang menjadi asal TWebBrowser), klik mouse pertama akan dimakan. Mereka kemudian harus mengklik lagi untuk memberikan fokus kontrol. Kemudian mereka dapat berinteraksi dengan kontrol.

Dia memiliki komentar untuk dijelaskan:

Setiap kontrol yang diturunkan dari TOleControl berpotensi menimbulkan masalah fokus.

Untuk menghindari penyertaan unit OleCtrls (yang antara lain akan menyertakan Varian), yang memungkinkan pengujian kelas TOleControl, antarmuka IOleClientSite digunakan untuk tes yang didukung oleh TOleControl dan indikator yang baik.

Dari cuplikan lengkap:

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;

Masalahnya adalah solusi tersebut tidak lagi berhasil untuk saya. Dan sejujurnya saya tidak tahu apa masalahnya sebenarnya, dan bagaimana solusinya memperbaikinya.

Adakah orang yang mengetahui komentarnya, memahami apa yang dia bicarakan, dapat menjelaskan apa masalahnya, dan bagaimana cara yang dia lakukan untuk memperbaikinya?

Solusi untuk kontrol non-VCL yang dibungkus (seperti TWebBrowser), yang tidak menggunakan mekanisme VCL dan membiarkan properti ActiveControl dalam kondisi yang salah, yang menyebabkan masalah saat kontrol difokuskan ulang. Setiap kontrol yang berasal dari TOleControl berpotensi memiliki masalah fokus.

Kode sudah mencapai tujuan

Form.ActiveControl := nil; 

pernyataan, tapi itu tidak berhasil.

saya akan memperbaikinya, tetapi saya tidak tahu bagaimana dia menemukannya, atau bagaimana hal itu bisa terjadi sehingga TOleControl tidak menggunakan mekanisme VCL dan meninggalkan properti ActiveControl dalam keadaan yang salah< /em>.


Bonus Bacaan

Saya pertama kali menanyakan pertanyaan ini di borland.public.delphi.nativeapi.win32 newsgroup pada tahun 2008

Pertanyaan di forum Soft-Gems

Bump 20110515 (12 bulan kemudian)

Bump 20150401 (7 tahun kemudian): Masih tidak berfungsi di XE6

Bump 20210309 (11 tahun kemudian)


person Ian Boyd    schedule 13.05.2009    source sumber
comment
Apakah Virtual TreeView tidak berfungsi. Versi terakhir dari 14. mars 09? Mungkin Komponen Delphi terhebat yang pernah ada IMHO.   -  person Tom    schedule 13.05.2009
comment
Itu sudah tidak berfungsi ketika saya pertama kali menanyakan pertanyaan itu. Ketika Mike beralih ke pengembangan Mac dan MySQL, VT tidak terlihat bagus. Ada beberapa dukungan sporadis, tapi tidak ada yang resmi.   -  person Ian Boyd    schedule 13.05.2009
comment
Saat memberi tag ulang pada pertanyaan ini untuk menggunakan beberapa tag yang ada, saya menemukan bahwa tag tvirtualtreeview sudah ada dalam pertanyaan ini: stackoverflow.com/questions/687438 . Anda akan lebih tahu mana yang benar, jadi maukah Anda mengubah salah satunya? Terima kasih.   -  person Michael Myers    schedule 14.05.2009
comment
Mike sendiri menyebut produknya sebagai Virtual Treeview, dan jika Anda mencari di Google untuk virtualtreeview dan tvirtualtreeview, Anda akan menemukan lebih banyak entri untuk virtualtreeview. Jadi saya telah mengubah tag pertanyaan lain dari tvirtualtreeview menjadi virtualtreeview.   -  person lkessler    schedule 14.05.2009
comment
Versi terbaru VirtualTreeview 4.8.5 tidak berfungsi di Delphi 2009, dan tidak ada indikasi di Forum mereka jika ada orang yang menyelidiki hal ini.   -  person lkessler    schedule 14.05.2009
comment
tidak berfungsi di Delphi 2009. Lalu apa yang saya gunakan saat ini? Kode dari bintang? 4.8.5 berfungsi. Bahkan 4.7.0 bekerja dengan Delphi 2009.   -  person Andreas Hausladen    schedule 14.05.2009
comment
Situs dan forum resmi sudah mati. Untuk sesuatu yang kurang resmi, lihat di sini: delphipraxis.net/ (dalam bahasa Jerman).   -  person Uli Gerhardt    schedule 14.05.2009
comment
Apakah pembaruan pada 16-03-2009 berarti situs web tersebut mati? soft-gems.net/   -  person Andreas Hausladen    schedule 14.05.2009
comment
Saya ingin mengatakan bahwa tidak ada tempat sentral untuk diskusi pembangunan (seperti Mantis). Diskusi berlangsung mis. di Delphi-Praxis. Maaf bila membingungkan.   -  person Uli Gerhardt    schedule 14.05.2009


Jawaban (1)


Saya telah mengatasi masalah ini dengan menggunakan TEmbeddedWB (yang jauh lebih baik daripada TWebBrowser standar) dan kemudian saya harus menambahkan acara OnShowUI ini:

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;


Namun jika Anda harus menggunakan TWebBrowser Anda perlu menulis lebih banyak kode:

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
Saya menggunakan TEmbeddedWB, tetapi masalahnya juga terjadi dengan TWebBrowser - dan saya tidak ingin orang-orang langsung menyalahkan TEmbeddedWB. saya mencoba menambahkan CanFocus/SetFocus ke acara OnShowUI - tidak berhasil. Terutama karena acara OnShowUI tidak benar-benar diaktifkan sampai saya mengklik kontrol browser web. - person Ian Boyd; 14.05.2009