\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
const\r
WS_EX_TOOLWINDOW = $80;\r
WS_POPUP = longint($80000000);\r
+ CW_USEDEFAULT=$80000000;\r
hinstance=nil;\r
PM_REMOVE = 1;\r
WM_USER = 1024;\r
WM_TIMER = 275;\r
INFINITE = syncobjs.infinite;\r
+\r
function getwindowlongptr(ahwnd:hwnd;nindex:integer) : taddrint;\r
function setwindowlongptr(ahwnd:hwnd;nindex:integer;dwNewLong : taddrint) : taddrint;\r
function DefWindowProc(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;\r
\r
implementation\r
uses\r
- baseunix,unix,lcore,unixutil;//,safewriteln;\r
+ baseunix,unix,lcore,unixutil,ltimevalstuff,sockets;//,safewriteln;\r
{$i unixstuff.inc}\r
\r
type\r
+ \r
tmessageintransit = class\r
msg : tmsg;\r
next : tmessageintransit;\r
waiting : boolean;\r
lcorethread : boolean;\r
nexttimer : ttimeval;\r
- threadid : integer;\r
+ threadid : tthreadid;\r
end;\r
twindow=class\r
hwnd : hwnd;\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
+function findthreaddata(threadid : tthreadid) : tthreaddata;\r
begin\r
- result := tthreaddata(findtree(@threaddata,inttostr(threadid)));\r
+ result := tthreaddata(findtree(@threaddata,inttostr(taddrint(threadid))));\r
if result = nil then begin\r
result := tthreaddata.create;\r
result.messageevent := teventobject.create(nil,false,false,inttostr(taddrint(result)));\r
result.nexttimer := tv_invalidtimebig;\r
result.threadid := threadid;\r
- addtree(@threaddata,inttostr(threadid),result);\r
+ addtree(@threaddata,inttostr(taddrint(threadid)),result);\r
end;\r
end;\r
\r
//writeln('freeing thread data object');\r
athreaddata.free;\r
//writeln('deleting thread data object from hashtable');\r
- deltree(@threaddata,inttostr(athreaddata.threadid));\r
+ deltree(@threaddata,inttostr(taddrint(athreaddata.threadid)));\r
//writeln('finished deleting thread data');\r
end else begin\r
//writeln('thread data is not unused');\r
//writeln('aboute to delete window from windows structure');\r
deltree(@windows,inttostr(ahwnd));\r
//writeln('deleted window from windows structure');\r
- windowthreaddata := tthreaddata(findtree(@threaddata,inttostr(window.threadid)));\r
+ windowthreaddata := tthreaddata(findtree(@threaddata,inttostr(taddrint(window.threadid))));\r
\r
if windowthreaddata <> nil then begin\r
//writeln('found thread data scanning for messages to clean up');\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