Delphi: TOleControl puts ActiveControl in wrong state? - delphi

Question

In Mike Lischke's Virtual Treeview, there was workaround code
added to fix a bug when using a TWebBrowser control on the same form.
The problem was that if the user tries to interact with a TOleControl (from which TWebBrowser descends), the first mouse click is eaten. They have to then click again to give the control focus. Then they can interact with the control.
He has comments to explain:
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.
From the full snippit:
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;
Problem is that the workaround is no longer working for me. And to be honest i have no idea what the problem really was, and how his solution fixed it.
Is there anyone who knows what his comments understand what he's talking about, could explain what the problem is, and how what he's doing was supposed to fix it?
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. Every control
derived from TOleControl has
potentially the focus problem.
The code is reaching the intended
Form.ActiveControl := nil;
statement, but it just isn't doing the trick.
i'd fix it, but i have no idea how he found it, or how it can come about that TOleControl doesn't "use VCL mechanisms and leaves the ActiveControl property in the wrong state."
Bonus Reading
I originally asked this question on
borland.public.delphi.nativeapi.win32 newsgroup in 2008
Question on Soft-Gems forum
Bump 20110515 (12 months later)
Bump 20150401 (7 years later): Still doesn't work in XE6
Bump 20210309 (11 years later)

Answer 1

I have overcome this issue by 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;