Forum > Windows
Receive and Handle Windows Messages
DelphiBoy:
I'm trying to port a class I've written in Delphi to Lazarus. It relies on WM_DEVICECHANGE to detect attached USB devices (need to derive from TComponent). I can't get my component to receive Windows messages, while it was working perfectly in Delphi.
I know that AllocateHwnd is just a placeholder in Free Pascal, so I'm trying to mimic what LCL does (here I'm using WM_PAINT for testing):
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---TUSB = class(TComponent)private FHandle: HWND; procedure WndProc(var Msg: TMessage);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; function MyAllocateHwnd(Method: TWndMethod):HWND;var PMethod: ^TWndMethod; begin Result := Windows.CreateWindow(PChar('STATIC'), '', WS_OVERLAPPED, 0, 0, 0, 0, HWND_MESSAGE, 0, MainInstance, nil); if (Result = 0) then ShowMessage('error:'+IntToStr(GetLastError)); if Assigned(Method) then begin Getmem(PMethod, SizeOf(TMethod)); PMethod^ := Method; SetWindowLong(Result, GWL_USERDATA, {%H-}PtrInt(PMethod)); end; SetWindowLong(Result, GWL_WNDPROC, {%H-}PtrInt(@CallbackAllocateHWnd));end; procedure TUSB.WndProc(var Msg: TMessage);begin if Msg.Msg = WM_PAINT then ShowMessage('message received') else Msg.Result:= DefWindowProc(FHandle, Msg.Msg, Msg.WParam, Msg.LParam);end; constructor TUSB.Create(AOwner: TComponent);begin inherited Create(AOwner); FHandle:= MyAllocateHwnd(@WndProc);end;
This gives me a valid window handle, but a breakpoint in CallbackAllocateHWnd is never hit by SendMessage(). Exactly the same lines of code, works in Delphi (without using built-in AllocateHwnd). What am I missing?
PS: I know this is specific to Windows and not portable. That's fine.
Handoko:
Hello DelphiBoy,
Welcome to this forum.
I found that this link below maybe useful for you:
http://forum.lazarus.freepascal.org/index.php?topic=6062.0
marcov:
He registers an own handle, so it should be entirely outside of the lcl's control.
At first glace everything is ok. Checking return values from functions seems most prudent
DelphiBoy:
I just found out that after line
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---SetWindowLong(Result, GWL_WNDPROC, {%H-}PtrInt(@CallbackAllocateHWnd));
GetLastError returns 1413, which is "invalid index". I added SetLastError(0) as per instructions here: https://msdn.microsoft.com/en-us/library/windows/desktop/ms633591(v=vs.85).aspx
Just to test, I replaced SetWindowLong, with GetWindowLong and it also gives me 1413.
Any ideas?
DonAlfredo:
I use an LCL function to alloc:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---{$ifdef FPC} FHWnd := LCLIntf.AllocateHWnd(EventPipe);{$else} FHWnd := AllocateHWnd(EventPipe);{$endif}
Navigation
[0] Message Index
[#] Next page