我試圖將我在Delphi中編寫的類移植到Lazarus。它依靠WM_DEVICECHANGE
來檢測連接的USB設備。我不能讓我的組件接收Windows消息,而它在Delphi中完美運行。在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後調用GetLastError
意味着無效索引。我甚至在那裏試過GetWindowLong
,並給我同樣的錯誤!
是否allochandle運行?另外據我所知SetWindowLong函數返回舊的WndProc,保存和調用它在你的WndProc –
FHandle具有運行AllocHandle後一個有效的窗口句柄,但是當消息被髮送給它我的自定義的WndProc不會被觸發。 –