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;