How to get the Window Handle from inside WndProc?

Question

Maybe a stupid question, but...

I'm writing a class that should take care of keeping a Window (FGuestHWnd, from now on) visually anchored to a "Host Window" (FHostHWnd).

• FGuestHWnd and HostHWnd have NO parent/owner/child relationship.
• FGuestHWnd belongs to another process - don't care.
• FHostHWnd is the Window handle of a VCL TWinControl, so it's a child window inside my process. It can sit at any level inside the Parent/Child tree. For example, let's say it's a TPanel.

Now I have to "hook" FHostHWnd's moving/resizing and call SetWindowPos(FGuestHWnd... after my custom calculation.

Resizing is straightforward: I can use SetWindowLong(FHostHWnd, GWL_WNDPROC, ...) to "redirect" FHostHWnd's WndProc to my custom WindowPorcedure and trap WM_WINDOWPOSCHANGING. This message is automatically sent to FHostHWnd when one of its ancestors get resized, because FHostHWnd is client-aligned.

MOVING, if I'm not missing something, is a little trickier because if i move the main form FHostHWnd is not really moved. It keeps the same position relative to its parent. So it is NOT notified in any way of an ancestor's movement.

My solution is to "redirect" ANY ANCESTOR's WndProc to a custom Window Procedure and trap WM_WINDOWPOSCHANGING for "move" messages only. In that case I could notify FHostHWnd with a custom message. Some fields inside my class will keep track of the chain of Win Handles, Original WndProc addesses and new WndProc addresses.

Here is some code to explain my structure:

TMyWindowHandler = class(TObject)
private
  FHostAncestorHWndList: TList;
  FHostHWnd: HWND;
  FGuestHWnd: HWND;
  FOldHostAncestorWndProcList: TList;
  FNewHostAncestorWndProcList: TList;
  //...
  procedure HookHostAncestorWindows;
  procedure UnhookHostAncestorWindows;
  procedure HostAncestorWndProc(var Msg: TMessage);
end;

procedure TMyWindowHandler.HookHostAncestorWindows;
var
  ParentHWnd: HWND;
begin
  ParentHWnd := GetParent(FHostHWnd);
  while (ParentHWnd > 0) do
  begin
    FHostAncestorHWndList.Insert(0, Pointer(ParentHWnd));
    FOldHostAncestorWndProcList.Insert(0, TFarProc(GetWindowLong(ParentHWnd,     GWL_WNDPROC)));
    FNewHostAncestorWndProcList.Insert(0, MakeObjectInstance(HostAncestorWndProc));
    Assert(FOldHostAncestorWndProcList.Count = FHostAncestorHWndList.Count);
    Assert(FNewHostAncestorWndProcList.Count = FHostAncestorHWndList.Count);
    if (SetWindowLong(ParentHWnd, GWL_WNDPROC, LongInt(FNewHostAncestorWndProcList[0])) = 0) then
      RaiseLastOSError;
    ParentHWnd := GetParent(FHostHWnd);
  end;
end;

and here is The Handler:

procedure TMyWindowHandler.HostAncestorWndProc(var Msg: TMessage);
var
  pNew: PWindowPos;
begin
  case Msg.Msg of
    WM_DESTROY: begin
      UnHookHostAncestorWindows;
    end;
    WM_WINDOWPOSCHANGING: begin
      pNew := PWindowPos(Msg.LParam);
      // Only if the window moved!
      if ((pNew.flags and SWP_NOMOVE) = 0) then
      begin
        //
        // Do whatever
        //
      end;
    end;
  end;
  Msg.Result := CallWindowProc(???, ???, Msg.Msg, Msg.WParam, Msg.LParam );
end;

My question is:

How can I get the Window Handle from inside my WindowProcedure when I finally invoke CallWindowProc?
(If I had the Window Handle I could also find it in FOldHostAncestorWndProcList, then lookup the right Old-WndProc-pointer in FHostAncestorHWndList) Or, as an alternative, how to get the CURRENT method pointer so that I can find it in FNewHostAncestorWndProcList and lookup the HWND in FHostAncestorHWndList.

Or do you suggest other solutions?

Notice that I'd like to keep everything HWND-oriented, not VCL/TWinControl-aware.
In other words, my application should only instantiate TMyWindowHandler passing to it the two HWNDs (host and guest).

Answer 1

Personally I would not use MakeObjectInstance here. MakeObjectInstance is useful if you wish to bind the instance to a single window handle. The magic of MakeObjectInstance is the generation of a thunk that forwards window procedure calls to instance methods. And in doing so, the window handle is not passed to the instance method because the assumption is that the instance already knows its associated window handle. That's certainly the case for TWinControl, the prime use case of MakeObjectInstance.

Now, you are binding it to multiple window handles. When the instance method executes you have no way to know which of the many window handles is associated with this method execution. That is the very crux of your problem.

My recommendation is to abandon MakeObjectInstance because it does not meet your needs. Instead, define a plain window procedure of this form:

function WindowProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; 
  lParam: LPARAM): LRESULT; stdcall;

When you implement the window procedure like this, you do receive a window handle, as you desire.

You may well need to keep a global list of TMyWindowHandler instances so that you can lookup the TMyWindowHandler instance associated with the window passed to your window procedure. Alternatively you could use SetProp to associate some data with the window.

Note that the way you are sub-classing windows has various problems. The SetWindowSubclass function is provided to avoid these problems. More details here: Subclassing Controls.

Answer 2

It is possible to pass user-defined data to MakeObjectInstance(). It takes a closure as input, and a closure can be manipulated using the TMethod record, so you can set its Data field to point at whatever you want and it will be accessible via the Self pointer inside the method body. For example:

type
  PMyWindowHook = ^TMyWindowHook;
  TMyWindowHook = record
    Wnd: HWND;
    OldWndProc: TFarProc;
    NewWndProc: Pointer;
    Handler: TMyWindowHandler;
  end;

  TMyWindowHandler = class
  private
    FHostAncestorHWndList: TList;
    FHostAncestorWndProcList: TList;
    FHostHWnd: HWND;
    FGuestHWnd: HWND;
    //...
    procedure HookHostAncestorWindows;
    procedure UnhookHostAncestorWindows;
    procedure HostAncestorWndProc(var Msg: TMessage);
  end;

procedure TMyWindowHandler.HookHostAncestorWindows;
var
  ParentHWnd: HWND;
  Hook: PMyWindowHook;
  NewWndProc: Pointer;
  M: TWndMethod;
begin
  ParentHWnd := GetParent(FHostHWnd);
  while ParentHWnd <> 0 do
  begin
    M := HostAncestorWndProc;
    New(Hook);
    try
      TMethod(M).Data := Hook;
      Hook.Hwnd := ParentHWnd;
      Hook.OldWndProc := TFarProc(GetWindowLong(ParentHWnd, GWL_WNDPROC));
      Hook.NewWndProc := MakeObjectInstance(M);
      Hook.Handler := Self;
      FHostAncestorWndProcList.Insert(0, Hook);
      try
        SetLastError(0);
        if SetWindowLongPtr(ParentHWnd, GWL_WNDPROC, LONG_PTR(Hook.NewWndProc)) = 0 then
        begin
          if GetLastError() <> 0 then
          begin
            FreeObjectInstance(Hook.NewWndProc);
            RaiseLastOSError;
          end;
        end;
      except
        FHostAncestorWndProcList.Delete(0);
        raise;
      end;
    except
      Dispose(Hook);
      raise;
    end;
    ParentHWnd := GetParent(ParentHWnd);
  end;
end;

procedure TMyWindowHandler.UnhookHostAncestorWindows;
var
  Hook: PMyWindowHook;
begin
  while FHostAncestorWndProcList.Count > 0
  begin
    Hook := PMyWindowHook(FHostAncestorWndProcList.Items[0]);
    FHostAncestorWndProcList.Delete(0);
    SetWindowLongPtr(Hook.Hwnd, GWL_WNDPROC, LONG_PTR(Hook.OldWndProc));
    FreeObjectInstance(Hook.NewWndProc);
    Dispose(Hook);
  end;
end;

procedure TMyWindowHandler.HostAncestorWndProc(var Msg: TMessage);
var
  Hook: PMyWindowHook;
  pNew: PWindowPos;
begin
  Hook := PMyWindowHook(Self);
  case Msg.Msg of
    WM_DESTROY: begin
      Msg.Result := CallWindowProc(Hook.Wnd, Hook.OldWndProc, Msg.Msg, Msg.WParam, Msg.LParam);
      Hook.Handler.FHostAncestorWndProcList.Remove(Hook);
      SetWindowLongPtr(Hook.Hwnd, GWL_WNDPROC, LONG_PTR(Hook.OldWndProc));
      FreeObjectInstance(Hook.NewWndProc);
      Dispose(Hook);
      Exit;
    end;
    WM_WINDOWPOSCHANGING: begin
      pNew := PWindowPos(Msg.LParam);
      // Only if the window moved!
      if (pNew.flags and SWP_NOMOVE) = 0 then
      begin
        //
        // Do whatever
        //
      end;
    end;
  end;
  Msg.Result := CallWindowProc(Hook.Wnd, Hook.OldWndProc, Msg.Msg, Msg.WParam, Msg.LParam);
end;

Granted, this is not an ideal setup. SetWindowSubClass() would be a much better choice than SetWindowLong(GWL_WNDPROC). The hook procedure gives you the HWND, and you can specify user-defined data. No hacks needed. For example:

type
  TMyWindowHandler = class
  private
    FHostAncestorHWndList: TList;
    FHostAncestorWndProcList: TList;
    FHostHWnd: HWND;
    FGuestHWnd: HWND;
    //...
    procedure HookHostAncestorWindows;
    procedure UnhookHostAncestorWindows;
    class function HostAncestorWndProc(HWND hWnd, UINT uMsg, WPARAM wParam, LPARAM lParam, UINT_PTR uIdSubclass, DWORD_PTR dwRefData): LRESULT; stdcall; static;
  end;

procedure TMyWindowHandler.HookHostAncestorWindows;
var
  ParentHWnd: HWND;
begin
  ParentHWnd := GetParent(FHostHWnd);
  while ParentHWnd <> 0 do
  begin
    FHostAncestorWndProcList.Insert(0, Pointer(ParentWnd));
    try
      if not SetWindowSubclass(ParentWnd, @HostAncestorWndProc, 1, DWORD_PTR(Self)) then
        RaiseLastOSError;
    except
      FHostAncestorWndProcList.Delete(0);
      raise;
    end;
    ParentHWnd := GetParent(ParentHWnd);
  end;
end;

procedure TMyWindowHandler.UnhookHostAncestorWindows;
begin
  while FHostAncestorWndProcList.Count > 0 do
  begin
    RemoveWindowSubclass(HWND(FHostAncestorWndProcList.Items[0]), @HostAncestorWndProc, 1);
    FHostAncestorWndProcList.Delete(0);
  end;
end;

class function TMyWindowHandler.HostAncestorWndProc(HWND hWnd, UINT uMsg, WPARAM wParam, LPARAM lParam, UINT_PTR uIdSubclass, DWORD_PTR dwRefData): LRESULT; stdcall;
var
  pNew: PWindowPos;
begin
  case uMsg of
    WM_NCDESTROY: begin
      RemoveWindowSubclass(hWnd, @HostAncestorWndProc, 1);
      TMyWindowHandler(dwRefData).FHostAncestorWndProcList.Remove(Pointer(hWnd));
    end;
    WM_WINDOWPOSCHANGING: begin
      pNew := PWindowPos(Msg.LParam);
      // Only if the window moved!
      if (pNew.flags and SWP_NOMOVE) = 0 then
      begin
        //
        // Do whatever
        //
      end;
    end;
  end;
  Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;