如何从WndProc中获取窗口句柄？

我正在写一个class应采取保持一个窗口的护理（FGuestHWnd，从现在起）视觉锚定到“主机窗口”（FHostHWnd）。

FGuestHWnd和HostHWnd没有父母/所有者/子女关系。
FGuestHWnd属于另一个过程 - 不关心。
FHostHWnd是VCL TWinControl的窗口句柄，所以这是我的过程中的一个子窗口。它可以坐在父/子树内的任何级别。例如，假设这是一个TPanel。

现在我必须“钩”FHostHWnd的移动/调整大小，并在我的自定义计算后调用SetWindowPos(FGuestHWnd...。调整大小非常简单：我可以使用SetWindowLong(FHostHWnd, GWL_WNDPROC, ...)将FHostHWnd的WndProc“重定向到”我的自定义WindowPorcedure和陷阱WM_WINDOWPOSCHANGING。由于FHostHWnd是客户端对齐的，因此此消息会自动发送到FHostHWnd，因为其中一个祖先的大小已调整。

感动，如果我不缺少的东西，是有点麻烦，因为如果我移动的主要形式FHostHWnd是不是真的很感动。它保持与其父母相同的位置。所以它不会以任何方式通知祖先的移动。

我的解决办法是有父的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;

这里是处理程序：

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;

我的问题是：

我怎样才能得到的窗口句柄从我的WindowProcedure里面，当我最终调用CallWindowProc？（如果我有窗口句柄，我也可以在FOldHostAncestorWndProcList中找到它，然后在FHostAncestorHWndList中查找右边的Old-WndProc-pointer）或者，作为替代，如何获取CURRENT方法指针，以便我可以在其中找到它FNewHostAncestorWndProcList并在FHostAncestorHWndList中查找HWND。

或者你提出其他解决办法？

请注意，我想保留一切HWND为导向，而不是VCL/TWinControl感知。
换句话说，我的应用程序应该只实例TMyWindowHandler传递给它两个HWND S（主机和客户）。

来源

2014-07-02 yankee

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

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

我的建议是放弃MakeObjectInstance，因为它不符合您的需求。取而代之的是，这种形式的平面窗口过程：当你实现这样的窗口过程

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

，您就可以获得一个窗口句柄，你的愿望。

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

请注意，您对子窗口进行子分类的方式存在各种问题。提供SetWindowSubclass函数是为了避免这些问题。更多细节在这里：Subclassing Controls。

来源

2014-07-02 14:07:56

谢谢大卫。但是'MakeObjectInstance'不是专门为解决这个问题而存在的吗？看起来VCL本身绑定了一个'TWinControl'的'WndProc'。 – yankee

我已经扩大了。 'MakeObjectInstance'是你的问题。 'AllocateHwnd'和'TWinControl.Create'使用它来形成窗口和实例之间的一对一关系。您的问题具有多对一的实例关系。所以'MakeObjectInstance'根本不好。 –

好点大卫。谢谢。 – yankee

可以将用户定义的数据传递给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;

当然，这不是一个理想的设置。 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;

来源

2014-07-02 17:19:32

+1关于'MakeObjectInstance'的有趣信息。我结束了使用'SetWindowSubclass'。更干净。 – yankee

尽管如此，这是一个宝贵的例子（在Delphi中）如何使用'SetWindowSubclass'。 –

如何从WndProc中获取窗口句柄？

回答

相关问题