Search code examples
delphilazarusfreepascalwindows-messages

Receive and Handle Windows Messages in Lazarus


I'm trying to port a class I've written in Delphi to Lazarus. It relies on WM_DEVICECHANGE to detect attached USB devices. I can't get my component to receive Windows messages, while it was working perfectly in Delphi.

After realizing that AllocateHwnd is just a placeholder in Free Pascal, I started to mimic what LCL does for that purpose.

TUSB = class(TComponent)
private
    FHandle: HWND;
    procedure WndProc(var Msg: TMessage);
    procedure AllocHandle(Method: TWndMethod);
public
    constructor Create(AOwner: TComponent);
end;
.
.
.
procedure CallbackAllocateHWnd(Ahwnd: HWND; uMsg: UINT; wParam: WParam; lParam: LParam); stdcall;
var
  Msg: TMessage;
  PMethod: ^TWndMethod;
begin
  FillChar(Msg{%H-}, SizeOf(Msg), #0);

  Msg.msg := uMsg;
  Msg.wParam := wParam;
  Msg.lParam := lParam;

  PMethod := {%H-}Pointer(GetWindowLong(ahwnd, GWL_USERDATA));

  if Assigned(PMethod) then PMethod^(Msg);

  Windows.DefWindowProc(ahwnd, uMsg, wParam, lParam);
end;

procedure TUSB.AllocHandle(Method: TWndMethod);
var
  PMethod: ^TWndMethod;
begin
  FHandle := Windows.CreateWindow(PChar('STATIC'), '', WS_OVERLAPPED, 0, 0, 0, 0, 0, 0, MainInstance, nil);
  if Assigned(Method) then 
  begin
    Getmem(PMethod, SizeOf(TMethod));
    PMethod^ := Method;

    SetWindowLong(FHandle, GWL_USERDATA, {%H-}PtrInt(PMethod));
  end;

  SetWindowLong(FHandle, GWL_WNDPROC, {%H-}PtrInt(@CallbackAllocateHWnd));
end; 

constructor TUSB.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  AllocHandle(@WndProc);
end;

This gives me a valid window handle but CallbackAllocateHWnd is never called. I know that this stuff are Windows-specific and not portable, but that is not the concern now. I just want to derive a class from TComponent and be able to receive and handle Windows messages. The exact same lines of code, work in Delphi.

Edit: also tried HWND_MESSAGE as hWndParent.

Edit 2: I found that calling GetLastError after SetWindowLong(FHandle, GWL_WNDPROC, {%H-}PtrInt(@CallbackAllocateHWnd)); returns 1413 which means invalid index. I even tried GetWindowLong there and gives me the same error!


Solution

  • Just for reference of anyone else who ends up on this page:

    After getting ideas from Lazarus forum, I found that including LCLIntf unit in the uses clause will solve the issue. I followed the code in runtime and it ended up calling Windows.SetWindowLongPtrW. So just by replacing the second call to SetWindowLong with Windows.SetWindowLongPtrW now it works!