+{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
+ For conditions of distribution and use, see copyright notice in zlib_license.txt\r
+ which is included in the package\r
+ ----------------------------------------------------------------------------- }\r
+\r
+//this unit provides a rough approximation of windows messages on linux\r
+//it is usefull for multithreaded applications on linux to communicate back to\r
+//the main lcore thread\r
+//This unit is *nix only, on windows you should use the real thing\r
+\r
unit lmessages;\r
//windows messages like system based on lcore tasks\r
interface\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
\r
implementation\r
uses\r
- baseunix,unix,lcore;//,safewriteln;\r
+ baseunix,unix,lcore,unixutil,ltimevalstuff;//,safewriteln;\r
{$i unixstuff.inc}\r
\r
type\r
//than crash after over four billion\r
//windows have been made ;)\r
nextwindowhandle : qword = $100000000;\r
-{$i ltimevalstuff.inc}\r
+\r
\r
//findthreaddata should only be called while holding the structurelock\r
function findthreaddata(threadid : integer) : tthreaddata;\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
- 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
\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
end;\r
\r
-end.
\ No newline at end of file
+end.\r