How to pass information to window proc created using WinAPI-CodePudding

I needed to create a window for handling messages (WM_HOTKEY) so I went about going low level with the following and using SetWindowLong to pass the instance information for use in the windowproc.

fWindow:=CreateWindowEx(WS_EX_TOOLWINDOW,MsgWndClass.lpszClassName,'',WS_POPUP,0,0,0,0,0,0,HInstance,nil);
SetWindowLong(fWindow,GWL_USERDATA,NativeInt(Self));

and the windowproc is

class function TMessageWindow.WindowProc(hWnd: HWND; uMsg: Integer; wParam: WPARAM; lParam: LPARAM): Integer;
begin
  var I:=GetWindowLong(hWnd,GWL_USERDATA);
  if I=0 then
    Exit(DefWindowProc(hWnd,uMsg,wParam,lParam));

  Result:=TMessageWindow(I).HandleMessage(uMsg,wParam,lParam);
end;

My issues arise when I tried to create an inherited class from TMessageWindow with HandleMessage being virtual.
I found that although the HandleMessage function was overriden in the inherited class, the typecast of TMessageWindow(I) was calling the base method.

After searching around looking for an example of this I could not find any examples of people using the SetWindowLong function to pass information to the windowproc so am now thinking there must be a better way.

CodePudding user response：

First off, make sure your class method is also marked as static to remove the hidden Self parameter, and is using the stdcall calling convention, if you haven't already done so, eg:

class function WindowProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; static;

After that, if you are compiling for 64bit, your code needs to use (Get|Set)WindowLongPtr() instead, eg:

private
  fWindow: HWND;

fWindow := ...;
SetWindowLongPtr(fWindow, GWLP_USERDATA, LONG_PTR(Self));

class function TMessageWindow.WindowProc(hWnd: HWND; uMsg: Integer; wParam: WPARAM; lParam: LPARAM): Integer; stdcall;
begin
  var I := GetWindowLongPtr(hWnd, GWLP_USERDATA);
  if I <> 0 then
    Result := TMessageWindow(I).HandleMessage(uMsg, wParam, lParam)
  else
    Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;

Alternatively, use SetWindowSubclass() instead, eg:

private
  fWindow: HWND;
  class function SubclassWindowProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): LRESULT; stdcall; static;

uses
  ..., Commctrl;

fWindow := ...;
SetWindowSubclass(fWindow, @TMessageWindow.SubclassWindowProc, 1, DWORD_PTR(Self));

class function TMessageWindow.SubclassWindowProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): LRESULT; stdcall;
begin
  if uMsg = WM_NCDESTROY then
    RemoveWindowSubclass(hWnd, @TMessageWindow.SubclassWindowProc, uIdSubclass);
  Result := TMessageWindow(dwRefData).HandleMessage(uMsg, wParam, lParam);
  // have HandleMessage() call DefSubclassProc() for any unhandled messages...
end;

That being said, an easier way to create a message window with a virtual message procedure is to use the RTL's AllocateHWnd() function instead, eg:

private
  fWindow: HWND;
  procedure HandleMessage(var Message: TMessage); virtual;

// to create the window:
fWindow := AllocateHWnd(HandleMessage);
// to destroy the window:
DeallocateHWnd(fWindow);

procedure TMessageWindow.HandleMessage(var Message: TMessage);
begin
  with Message do
    Result := DefWindowProc(fWindow, Msg, WParam, LParam);
end;