如何从WndProc内部获取Window Handle？

Question

如何从WndProc内部获取Window Handle？

也许是一个愚蠢的问题,但......

我正在写一个class应该注意保持一个窗口(FGuestHWnd从现在开始)视觉锚定到"主机窗口"(FHostHWnd).

FGuestHWnd并且HostHWnd没有父母/所有者/子女关系.
FGuestHWnd 属于另一个过程 - 不在乎.
FHostHWnd是VCL的Window句柄TWinControl,因此它是我进程中的子窗口.它可以位于父/子树内的任何级别.例如,让我们说它是一个TPanel.

现在我必须"挂钩" FHostHWnd移动/调整大小并SetWindowPos(FGuestHWnd...在我的自定义计算后调用.

调整大小非常简单:我可以使用SetWindowLong(FHostHWnd, GWL_WNDPROC, ...)"重定向" FHostHWnd的WndProc到我的自定义WindowPorcedure和陷阱WM_WINDOWPOSCHANGING.FHostHWnd当其中一个祖先调整大小时,此消息会自动发送,因为它FHostHWnd是客户端对齐的.

移动,如果我没有遗漏某些东西,有点棘手,因为如果我移动主要形式FHostHWnd并没有真正感动.它保持相对于其父级的相同位置.因此,它不会以任何方式通知祖先的运动.

我的解决方案是将任何ANCESTOR的WndProc"重定向"到自定义窗口过程,并仅为"移动"消息捕获WM_WINDOWPOSCHANGING.在这种情况下,我可以FHostHWnd通过自定义消息通知.我班上的一些领域将跟踪Win Handles链,原始WndProc addesses和新的WndProc地址.

这里有一些代码来解释我的结构:

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;

Run Code Online (Sandbox Code Playgroud)

这是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;

Run Code Online (Sandbox Code Playgroud)

我的问题是:

当我最终调用时,如何从WindowProcedure中获取Window Handle CallWindowProc？
(如果我有窗口句柄,我也可以找到它FOldHostAncestorWndProcList,然后查找正确的Old-WndProc指针FHostAncestorHWndList)或者,作为替代方法,如何获取CURRENT方法指针,以便我可以找到它FNewHostAncestorWndProcList并查找HWND FHostAncestorHWndList.

或者您是否建议其他解决方案？

请注意,我希望保持一切以HWND为导向,而不是VCL/TWinControl.
换句话说,我的应用程序应该只实例化TMyWindowHandler传递给它的两个HWND(主机和客户机).

Answer 1

Rem*_*eau 6

可以将用户定义的数据传递给MakeObjectInstance().它需要一个闭包作为输入,并且可以使用TMethod记录操作闭包,因此您可以将其Data字段设置为指向您想要的任何内容,并且可以通过Self方法体内的指针访问它.例如:

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;

Run Code Online (Sandbox Code Playgroud)

当然,这不是一个理想的设置. SetWindowSubClass()会是一个更好的选择SetWindowLong(GWL_WNDPROC).钩子程序为您提供HWND,您可以指定用户定义的数据.不需要黑客.例如:

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;

Run Code Online (Sandbox Code Playgroud)

Answer 2

Dav*_*nan 5

我个人不会MakeObjectInstance在这里使用.MakeObjectInstance如果您希望将实例绑定到单个窗口句柄,则非常有用.神奇的MakeObjectInstance是生成一个thunk,它将窗口过程调用转发给实例方法.在这样做时,窗口句柄不会传递给实例方法,因为假设实例已经知道其关联的窗口句柄.这当然是TWinControl主要的用例MakeObjectInstance.

现在,您将它绑定到多个窗口句柄.当实例方法执行时,您无法知道许多窗口句柄中的哪一个与此方法执行相关联.这是你问题的关键所在.

我的建议是放弃,MakeObjectInstance因为它不符合您的需求.而是,定义此窗体的纯窗口过程:

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

Run Code Online (Sandbox Code Playgroud)

当你实现这样的窗口过程时,你会收到一个窗口句柄,如你所愿.

您可能需要保留TMyWindowHandler实例的全局列表,以便可以查找TMyWindowHandler与传递给窗口过程的窗口关联的实例.或者,您可以使用SetProp将某些数据与窗口相关联.

请注意,您对窗口进行子类化的方式存在各种问题.SetWindowSubclass提供该功能是为了避免这些问题.更多细节:子类控件.

归档时间：	12 年，2 月前
查看次数：	1956 次
最近记录：	10 年前