私はDelphiで書いたクラスをLazarusに移植しようとしています。接続されたUSBデバイスを検出するには、WM_DEVICECHANGE
が必要です。 Delphiで完全に機能していたのに、私のコンポーネントがWindowsのメッセージを受け取ることができません。LazarusでのWindowsメッセージの受信と処理
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:の後にSetWindowLong(FHandle, GWL_WNDPROC, {%H-}PtrInt(@CallbackAllocateHWnd));
が返され、1413が無効なインデックスであることが判明しました。私もそこにGetWindowLong
しようとし、私に同じエラーを与える!
アレンチャンドルは走っていますか?またafaik setwindowlongは古いwndprocを返し、保存してwndprocで呼び出します。 –
FHandleはAllocHandleを実行した後に有効なウィンドウハンドルを持っていますが、カスタムWndProcはメッセージが送信されたときにトリガーされません。 –