2017-04-08 30 views
0

私は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しようとし、私に同じエラーを与える!

+0

アレンチャンドルは走っていますか?またafaik setwindowlongは古いwndprocを返し、保存してwndprocで呼び出します。 –

+0

FHandleはAllocHandleを実行した後に有効なウィンドウハンドルを持っていますが、カスタムWndProcはメッセージが送信されたときにトリガーされません。 –

答えて

1

はちょうどこのページで終わる他の誰の参考のために:ラザロのフォーラムからのアイデアを取得した後

、私はuses句でLCLIntfにユニットを含めても問題が解決することを見出しました。私は実行時にコードを辿り、それはWindows.SetWindowLongPtrWを呼び出し終わった。だから、SetWindowLongへの2回目の呼び出しをWindows.SetWindowLongPtrWに置き換えるだけで、今すぐ動作します!

関連する問題