Delphi: TOleControl puts ActiveControl in the wrong state?
In Mike Lischke's Virtual Treeview , a workaround has been added to fix a bug when using the TWebBrowser in the same form.
The problem was that if the user tries to interact with the TOleControl (from which the TWebBrowser descends) the first mouse click will be eaten. Then they need to click again to get control focus. Then, they can interact with the control.
He has comments to explain:
Every control derived from has the
TOleControl
potential to be a focus issue.To avoid including the OleCtrls block (which includes Variants among other things ), which will allow the class to be tested
TOleControl
, isIOleClientSite
used for a test that is supported by aTOleControl
good indicator.
From the complete snippet:
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;
The problem is that the workaround no longer works for me. And to be honest, I have no idea what the problem really is, and how his solution fixed this.
Is there anyone who knows that his comments understand what he is talking about, can explain what the problem is and how he was supposed to fix it?
A workaround for non-VCL-wrapped ones (such as TWebBrowser) that do not use the VCL mechanisms and leave the Invalid ActiveControl property in a state that causes problems when the control is refocused. Every control received from a TOleControl has a potential focus issue.
The code reaches the intended
Form.ActiveControl := nil;
but that just doesn't do the trick.
I would fix it, but I have no idea how he found it or how it might happen that TOleControl does not use VCL mechanisms and leaves the ActiveControl property in the wrong state. "
Reading bonuses
I originally asked this question on
borland.public.delphi.nativeapi.win32
a newsgroup in 2008
Question about the Soft-Gems Forum
Bump 20110515 (12 months later)
Bump 20150401 (7 years later): still not working in XE6
a source to share
I overcame this problem using TEmbeddedWB (which is much better than the standard TWebBrowser) and then I had to add this OnShowUI event:
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;
But if you must use TWebBrowser, you need to write more code:
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;
a source to share