BorlandTalk.com

Sean · Guest

Many thanks to Martin Larsson for providing the guts to this solution,
as found in his posting:

http://groups.google.com/groups?hl=en&lr=&ie=UTF-8&oe=UTF-8&selm=MPG.133a2222959bc089896bc%40forums.inprise.com&rnum=2

This is a very reliable workaround for the issue where an embedded
ActiveForm does not respond to various keystrokes (Tab, Arrow Keys,
etc.). It also addresses the issue of trying to make an ActiveForm
visible with late binding. Essentially the OleContainer object has
been inherited and augmented to provide the new keystroke information
to the activeform within it.

To use this method, observe the following sample code:

----------------------

....

uses
FixOleContainers

....

procedure TForm1.Button1Click(Sender: TObject);
var
EmployeeContainer: TNewOleContainer;
begin
EmployeeContainer := TNewOleContainer.EmbedActiveForm(TabSheet1,
'Employee.EmployeeX'); // instantiates the ActiveForm in a TabSheet
EmployeeContainer.OleObject.MyActiveFormProperty := True; //example
of working with the ActiveForm
end;

----------------------

And here follows the unit containing the code for the
TNewOleContainer. Just cut and paste into a fresh unit, save as
FixOleContainers.pas, and then you can use this in your application as
demonstrated above.

----------------------

unit FixOleContainers;

interface

uses
Windows, Controls, Messages, Forms, OleCtnrs;

type
IFixOleContainers = interface
end;

TNewOleContainer = class(TOleContainer)
private
fFixOleContainer: IFixOleContainers;
public
class function EmbedActiveForm(AParent: TWinControl;
AOleClassName: string): TNewOleContainer;
end;

TFixOleContainers = class(TInterfacedObject, IFixOleContainers)
public
hFixOleContainersHook: hHook;
constructor Create;
destructor Destroy; override;
class function EmbedActiveForm(AParent: TWinControl;
AOleClassName: string): TNewOleContainer;
end;

function GetMessageProc(nCode: Integer; wp: WParam; lp: LParam)
:LResult; stdcall;

var
gFixOleContainers: TFixOleContainers;

implementation

constructor TFixOleContainers.Create;
begin
hFixOleContainersHook := SetWindowsHookEx(WH_GETMESSAGE,
GetMessageProc,
HInstance,
GetCurrentThreadID);
end;

destructor TFixOleContainers.Destroy;
begin
UnHookWindowsHookEx(hFixOleContainersHook);
gFixOleContainers := nil;
inherited;
end;

function GetMessageProc(nCode: Integer; wp: WParam; lp: LParam)
:LResult;
var
msg : TMsg;
begin
msg := PMsg(lp)^;
if (msg.message >= WM_KEYFIRST) and (msg.message <= WM_KEYLAST) then
begin
if Screen.ActiveControl is TOleContainer then begin
TranslateMessage(Msg);
DispatchMessage(Msg);
PMsg(lp)^.message := WM_NULL;
PMsg(lp)^.lParam := 0;
PMsg(lp)^.wParam := 0;
end;
end;
Result := CallNextHookEx(gFixOleContainers.hFixOleContainersHook,
nCode, wp, lp);
end;

class function TFixOleContainers.EmbedActiveForm(AParent: TWinControl;
AOleClassName: string): TNewOleContainer;
begin
if not assigned(gFixOleContainers) then gFixOleContainers := Create;
result := TNewOleContainer.Create(AParent);
with result do begin
Parent := AParent;
Align := alClient;
BorderStyle := bsNone;
AutoActivate := aaGetFocus;
CreateObject(AOleClassName, false);
fFixOleContainer := gFixOleContainers;
end;
end;

class function TNewOleContainer.EmbedActiveForm(AParent: TWinControl;
AOleClassName: string): TNewOleContainer;
begin
result := TFixOleContainers.EmbedActiveForm(AParent, AOleClassName);
result.SetFocus;
keybd_event(VK_TAB, 0, 0, 0);
Application.ProcessMessages;
end;

initialization

finalization
if assigned(gFixOleContainers) then
UnHookWindowsHookEx(gFixOleContainers.hFixOleContainersHook);

end.

--------------------------

Sean