2017-04-08 90 views
0

我試圖將我在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,並給我同樣的錯誤!

+0

是否allochandle運行?另外據我所知SetWindowLong函數返回舊的WndProc,保存和調用它在你的WndProc –

+0

FHandle具有運行AllocHandle後一個有效的窗口句柄,但是當消息被髮送給它我的自定義的WndProc不會被觸發。 –

回答

1

只是爲了誰比誰這個網頁上結束的參考:

從拉撒路論壇得到的想法後,我發現,包括LCLIntf單位uses子句中會解決這個問題。我在運行時跟蹤了代碼,最終致電Windows.SetWindowLongPtrW。所以只需將SetWindowLong替換爲Windows.SetWindowLongPtrW即可使用!