How to get Window Handle from inside WndProc?

Maybe a stupid question, but ...

I am writing class, which should take care that the Window Window ( FGuestHWnd, henceforth) is visually bound to the "Host Window" ( FHostHWnd).

  • FGuestHWndand HostHWndhave no parent / owner / child relationship.
  • FGuestHWnd belongs to another process - don't care.
  • FHostHWndis a VCL window handle TWinControl, so this is a child window inside my process. It can sit at any level inside the parent / child tree. For example, let's say this TPanel.

Now I need to “intercept” the FHostHWndmove / resize and call SetWindowPos(FGuestHWnd...after my user calculation.

Resizing is simple: I can use WndProc SetWindowLong(FHostHWnd, GWL_WNDPROC, ...)to “redirect” FHostHWndto my custom WindowPorcedure and trap WM_WINDOWPOSCHANGING. This message is automatically sent to FHostHWndwhen one of its ancestors receives a size because it is FHostHWndaligned by click.

MOVEMENT, if I don’t miss something, is a little more complicated, because if I move the main form, FHostHWndit doesn’t actually move. He maintains the same position with respect to his parent. Therefore, he is in no way notified of the movement of the ancestors.

, "" ANY ANCESTOR WndProc Window WM_WINDOWPOSCHANGING "". FHostHWnd . Win Handles, Original 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;

:

Window Handle WindowProcedure, CallWindowProc?
( Window Handle, FOldHostAncestorWndProcList, Old-WndProc FHostAncestorHWndList) , , CURRENT, FNewHostAncestorWndProcList HWND FHostAncestorHWndList.

?

, HWND-, VCL/TWinControl-aware.
, TMyWindowHandler, HWND ( ).

+4
2

MakeObjectInstance . MakeObjectInstance , . MakeObjectInstance - thunk, . , , . , , TWinControl, MakeObjectInstance.

. , , . .

- MakeObjectInstance, . :

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

​​ , , .

TMyWindowHandler, TMyWindowHandler, , . SetProp, .

, , , . SetWindowSubclass , . : .

+5

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). hook 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;
+6

Source: https://habr.com/ru/post/1546867/


All Articles