1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:

uses
  SysUtils, Classes, Forms, Messages, Controls, Windows;

type
  TExternalForm = class(TWinControl)
  private
    FExternalHWND: HWND;
  private // old data values
    FOldParent: HWND;
    FOldStyle,
    FOldExStyle: DWORD;
    FOldWndProc: Pointer;
  protected
    procedure CreateWnd; override;
    procedure DestroyWindowHandle; override;
    procedure SetParent(AParent: TWinControl); override;
  public
    constructor Create(AOwner: TComponent; AExternalHWND: HWND); reintroduce;
    procedure DefaultHandler(var Message); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    property ExternalHWND: HWND read FExternalHWND;
  end;

implementation

function OnEnumChildProc(hwWindow: HWND; lpParam: Integer): Bool; stdcall;
var vOwner: TExternalForm;
begin
  try
    vOwner := TExternalForm(Pointer(lpParam));
    with TExternalForm.Create(vOwner, hwWindow) do
    begin
      Parent := vOwner;
      TabOrder := 0;
    end;
  except (* do nothing on error *) end;
  Result := TRUE;
end;

{ TExternalForm }

constructor TExternalForm.Create(AOwner: TComponent; AExternalHWND: HWND);
begin
  inherited Create(AOwner);
  FExternalHWND := AExternalHWND;

  if (Windows.GetWindowLong(FExternalHWND, GWL_STYLE) AND WS_CLIPCHILDREN) <> 0 then
    ControlStyle := [csAcceptsControls, csDoubleClicks, csNoStdEvents]
  else ControlStyle := [csDoubleClicks, csNoStdEvents];
  TabStop := (Windows.GetWindowLong(FExternalHWND, GWL_STYLE) AND WS_TABSTOP) <> 0;
end;

procedure TExternalForm.CreateWnd;
var vParams: TCreateParams;
begin
  if FExternalHWND = 0 then
    raise Exception.Create('No external window found.');

  // backup current properties
  FOldParent := Windows.GetParent(FExternalHWND);
  FOldWndProc := Pointer(GetWindowLong(WindowHandle, GWL_WNDPROC));
  FOldStyle := Windows.GetWindowLong(FExternalHWND, GWL_STYLE);
  FOldExStyle := Windows.GetWindowLong(FExternalHWND, GWL_EXSTYLE);

  // set new mandatory values
  CreateParams(vParams);
  Windows.SetParent(FExternalHWND, GetParentHandle);
  Windows.SetWindowLong(FExternalHWND, GWL_STYLE,
    ((FOldStyle OR vParams.Style OR WS_CHILD) AND
    NOT (WS_POPUP OR WS_CAPTION)));
  Windows.SetWindowLong(FExternalHWND, GWL_EXSTYLE,
    ((FOldExStyle OR vParams.ExStyle OR WS_EX_TOOLWINDOW)));

  // control operations
  WindowHandle := FExternalHWND;
  DefWndProc := Pointer(GetWindowLong(WindowHandle, GWL_WNDPROC));
  CreationControl := Self;
  SetWindowLong(WindowHandle, GWL_WNDPROC, Longint(@InitWndProc));
  SendMessage(WindowHandle, WM_NULL, 0, 0);

  // apply visibility
  if not Visible and IsWindowVisible(Handle) then
    ShowWindow(Handle, SW_HIDE);

  // do this for all child items too
  EnumChildWindows(FExternalHWND, @OnEnumChildProc, NativeInt(Self));
end;

const
  OCM_BASE = $2000;

procedure TExternalForm.DefaultHandler(var Message);
begin
  if HandleAllocated then
    with TMessage(Message) do
    begin
      if (Msg >= CN_BASE) and (Msg < CN_BASE + WM_USER) then
        Msg := Msg - (CN_BASE - OCM_BASE);
      if not (csAcceptsControls in ControlStyle) then
      begin
        Result := CallWindowProc(DefWndProc, Handle, Msg, WParam, LParam);
        exit;
      end;
    end;

  inherited DefaultHandler(Message);
end;

procedure TExternalForm.DestroyWindowHandle;
begin
  inherited;
  // control operations
  SetWindowLong(WindowHandle, GWL_WNDPROC, Longint(DefWndProc));
  WindowHandle := 0;

  // restore backed-up properties
  Windows.SetWindowLong(ExternalHWND, GWL_WNDPROC, Longint(FOldWndProc));
  Windows.SetParent(ExternalHWND, FOldParent);
  Windows.SetWindowLong(ExternalHWND, GWL_STYLE, FOldStyle);
  Windows.SetWindowLong(ExternalHWND, GWL_EXSTYLE, FOldExStyle);

  CallWindowProc(FOldWndProc, ExternalHWND, WM_SYSCOMMAND, SC_CLOSE , 0);
  DestroyWindow(ExternalHWND);

  FExternalHWND := 0;
end;

procedure TExternalForm.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited;
  SetWindowPos(FExternalHWND, 0, ALeft, ATop, AWidth, AHeight,
    SWP_NOZORDER OR SWP_NOACTIVATE );
end;

procedure TExternalForm.SetParent(AParent: TWinControl);
var
  LRecreate: Boolean;
begin
  LRecreate := HandleAllocated;
  if LRecreate then
    UpdateRecreatingFlag(True);
  try
    if (Parent = nil) and LRecreate then
      DestroyHandle;
    inherited;
    if Parent <> nil then
      Windows.SetParent(ExternalHWND, GetParentHandle);
  finally
    if LRecreate then
      UpdateRecreatingFlag(False);
  end;
end;