Question

我试图将用Delphi编写的课程移植到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;

这给了我一个有效的窗口句柄，但永远不会调用CallbackAllocateHWnd。我知道这些东西是特定于Windows的，不可移植，但现在不是问题。我只想从TComponent派生一个类，并能够接收和处理Windows消息。完全相同的代码行，在Delphi中工作。

修改：还尝试将HWND_MESSAGE设为hWndParent。

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

Answer 1

仅供参考此页面上的任何其他人参考：

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

在Lazarus中接收和处理Windows消息

1 个答案: