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!
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!