在 Lazarus 中接收和处理 Windows 条消息

Question

我正在尝试将我在 Delphi 中编写的 class 移植到 Lazarus。它依靠 WM_DEVICECHANGE 来检测连接的 USB 设备。我无法让我的组件接收 Windows 消息，而它在 Delphi.

中运行良好

意识到 AllocateHwnd 只是 Free Pascal 中的一个占位符后，我开始模仿 LCL 为此目的所做的工作。

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;

这给了我一个有效的 window 句柄，但从未调用过 CallbackAllocateHWnd。我知道这些东西是 Windows-specific 并且不可移植，但现在这不是问题。我只想从 TComponent 派生一个 class 并能够接收和处理 Windows 消息。完全相同的代码行，在 Delphi.

中工作

编辑：还尝试将 HWND_MESSAGE 作为 hWndParent。

编辑 2：我发现在 SetWindowLong(FHandle, GWL_WNDPROC, {%H-}PtrInt(@CallbackAllocateHWnd)); returns 1413 之后调用 GetLastError 意味着索引无效。我什至在那里尝试 GetWindowLong 并给了我同样的错误！

Answer 1

仅供最终访问此页面的其他人参考：

在从 Lazarus 论坛得到想法后，我发现在 uses 子句中包含 LCLIntf 单元可以解决问题。我在运行时遵循代码，它最终调用了 Windows.SetWindowLongPtrW。因此只需将对 SetWindowLong 的第二次调用替换为 Windows.SetWindowLongPtrW 现在就可以了！

在 Lazarus 中接收和处理 Windows 条消息

Receive and Handle Windows Messages in Lazarus

delphi

freepascal

lazarus

windows-messages