fix a bug in peekmessage

[lcore.git] / lmessages.pas

diff --git a/lmessages.pas b/lmessages.pas
index 1302e298afb5f3a5ed649bdc9f8a6f4f91ba8215..e17ccfe933b99e52adb663cc84b269efe28236ea 100755 (executable)
--- a/lmessages.pas
+++ b/lmessages.pas
@@ -14,6 +14,11 @@ interface
 \r
 uses pgtypes,sysutils,bsearchtree,strings,syncobjs;\r
 \r
 \r
 uses pgtypes,sysutils,bsearchtree,strings,syncobjs;\r
 \r

+\r
+{$if (fpc_version < 2) or ((fpc_version=2) and ((fpc_release < 2) or ((fpc_release = 2) and (fpc_patch < 2)) ))}\r
+  {$error this code is only supported under fpc 2.2.2 and above due to bugs in the eventobject code in older versions}\r
+{$endif}\r
+\r

 type\r
   lparam=taddrint;\r
   wparam=taddrint;\r
 type\r
   lparam=taddrint;\r
   wparam=taddrint;\r


@@ -404,11 +409,15 @@ begin
       //we have to get the window procedure while the structurelock\r
       //is still held as the window could be destroyed from another thread\r
       //otherwise.\r
       //we have to get the window procedure while the structurelock\r
       //is still held as the window could be destroyed from another thread\r
       //otherwise.\r

-      windowproc := window.windowproc;\r
+      if window <> nil then begin\r
+        windowproc := window.windowproc;\r
+      end else begin\r
+        windowproc := nil;\r
+      end;\r

     finally\r
       structurelock.release;\r
     end;\r
     finally\r
       structurelock.release;\r
     end;\r

-    if window <> nil then begin\r
+    if assigned(windowproc) then begin\r

       result := windowproc(lpmsg.hwnd,lpmsg.message,lpmsg.wparam,lpmsg.lparam);\r
     end else begin\r
       result := -1;\r
       result := windowproc(lpmsg.hwnd,lpmsg.message,lpmsg.wparam,lpmsg.lparam);\r
     end else begin\r
       result := -1;\r


@@ -485,7 +494,7 @@ end;
 \r
 function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): WINBOOL;\r
 begin\r
 \r
 function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): WINBOOL;\r
 begin\r

-  result := getmessageinternal(lpmsg,hwnd,wmsgfiltermin,wmsgfiltermax,PM_REMOVE,true);\r
+  result := getmessageinternal(lpmsg,hwnd,wmsgfiltermin,wmsgfiltermax,wRemoveMsg,true);\r

 end;\r
 \r
 function SetEvent(hEvent:THevent):WINBOOL;\r
 end;\r
 \r
 function SetEvent(hEvent:THevent):WINBOOL;\r