/[lcore]/trunk/lcoremessages.pas
ViewVC logotype

Contents of /trunk/lcoremessages.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 26 - (show annotations)
Fri Jan 23 01:40:05 2009 UTC (11 years, 6 months ago) by plugwash
Original Path: trunk/lmessages.pas
File size: 21822 byte(s)
add license header to lmessages.pas

1 { Copyright (C) 2005 Bas Steendijk and Peter Green
2 For conditions of distribution and use, see copyright notice in zlib_license.txt
3 which is included in the package
4 ----------------------------------------------------------------------------- }
5
6 unit lmessages;
7 //windows messages like system based on lcore tasks
8 interface
9
10 uses pgtypes,sysutils,bsearchtree,strings,syncobjs;
11
12 type
13 lparam=taddrint;
14 wparam=taddrint;
15 thinstance=pointer;
16 hicon=pointer;
17 hcursor=pointer;
18 hbrush=pointer;
19 hwnd=qword; //window handles are monotonically increasing 64 bit integers,
20 //this should allow for a million windows per second for over half
21 //a million years!
22
23 twndproc=function(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;
24
25
26 twndclass=record
27 style : dword;
28 lpfnwndproc : twndproc;
29 cbclsextra : integer;
30 cbwndextra : integer;
31 hinstance : thinstance;
32 hicon : hicon;
33 hcursor : hcursor;
34 hbrbackground : hbrush;
35 lpszmenuname : pchar;
36 lpszclassname : pchar;
37 end;
38 PWNDCLASS=^twndclass;
39
40 UINT=dword;
41 WINBOOL = longbool;
42 tTIMERPROC = procedure (ahwnd:HWND; umsg:integer; idevent:taddrint;dwtime:taddrint);stdcall;
43 ATOM = pointer;
44 LPCSTR = pchar;
45 LPVOID = pointer;
46 HMENU = pointer;
47 HINST = pointer;
48
49 TPOINT = record
50 x : LONGint;
51 y : LONGint;
52 end;
53
54 TMSG = record
55 hwnd : HWND;
56 message : UINT;
57 wParam : WPARAM;
58 lParam : LPARAM;
59 time : DWORD;
60 pt : TPOINT;
61 end;
62 THevent=TEventObject;
63 const
64 WS_EX_TOOLWINDOW = $80;
65 WS_POPUP = longint($80000000);
66 hinstance=nil;
67 PM_REMOVE = 1;
68 WM_USER = 1024;
69 WM_TIMER = 275;
70 INFINITE = syncobjs.infinite;
71 function getwindowlongptr(ahwnd:hwnd;nindex:integer) : taddrint;
72 function setwindowlongptr(ahwnd:hwnd;nindex:integer;dwNewLong : taddrint) : taddrint;
73 function DefWindowProc(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;
74 function RegisterClass(const lpWndClass:TWNDCLASS):ATOM;
75 function CreateWindowEx(dwExStyle:DWORD; lpClassName:LPCSTR; lpWindowName:LPCSTR; dwStyle:DWORD; X:longint;Y:longint; nWidth:longint; nHeight:longint; hWndParent:HWND; hMenu:HMENU;hInstance:HINST; lpParam:LPVOID):HWND;
76 function DestroyWindow(ahWnd:HWND):WINBOOL;
77 function PostMessage(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL;
78 function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): WINBOOL;
79 function DispatchMessage(const lpMsg: TMsg): Longint;
80 function GetMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT): WINBOOL;
81 function SetEvent(hEvent:THevent):WINBOOL;
82 function CreateEvent(lpEventAttributes:PSECURITYATTRIBUTES; bManualReset:WINBOOL; bInitialState:WINBOOL; lpName:pchar):tHevent;
83 function terminatethread(threadhandle : tthreadid;dummy:integer) : boolean;
84 function waitforsingleevent(event:thevent;timeout:cardinal) : twaitresult;
85 function SetTimer(ahWnd:HWND; nIDEvent:taddrint; uElapse:UINT; lpTimerFunc:tTIMERPROC):UINT;
86 function KillTimer(ahWnd:HWND; uIDEvent:taddrint):WINBOOL;
87
88 procedure init;
89
90 implementation
91 uses
92 baseunix,unix,lcore,unixutil;//,safewriteln;
93 {$i unixstuff.inc}
94
95 type
96 tmessageintransit = class
97 msg : tmsg;
98 next : tmessageintransit;
99 end;
100
101 tthreaddata = class
102 messagequeue : tmessageintransit;
103 messageevent : teventobject;
104 waiting : boolean;
105 lcorethread : boolean;
106 nexttimer : ttimeval;
107 threadid : integer;
108 end;
109 twindow=class
110 hwnd : hwnd;
111 extrawindowmemory : pointer;
112 threadid : tthreadid;
113 windowproc : twndproc;
114 end;
115
116 var
117 structurelock : tcriticalsection;
118 threaddata : thashtable;
119 windowclasses : thashtable;
120 lcorelinkpipesend : integer;
121 lcorelinkpiperecv : tlasio;
122 windows : thashtable;
123 //I would rather things crash immediately
124 //if they use an insufficiant size type
125 //than crash after over four billion
126 //windows have been made ;)
127 nextwindowhandle : qword = $100000000;
128 {$i ltimevalstuff.inc}
129
130 //findthreaddata should only be called while holding the structurelock
131 function findthreaddata(threadid : integer) : tthreaddata;
132 begin
133 result := tthreaddata(findtree(@threaddata,inttostr(threadid)));
134 if result = nil then begin
135 result := tthreaddata.create;
136 result.messageevent := teventobject.create(nil,false,false,inttostr(taddrint(result)));
137 result.nexttimer := tv_invalidtimebig;
138 result.threadid := threadid;
139 addtree(@threaddata,inttostr(threadid),result);
140 end;
141 end;
142
143 //deletethreaddataifunused should only be called while holding the structurelock
144 procedure deletethreaddataifunused(athreaddata : tthreaddata);
145 begin
146 //writeln('in deletethreaddataifunused');
147 if (athreaddata <> nil) then if (athreaddata.waiting=false) and (athreaddata.messagequeue=nil) and (athreaddata.lcorethread=false) and (athreaddata.nexttimer.tv_sec=tv_invalidtimebig.tv_sec) and (athreaddata.nexttimer.tv_usec=tv_invalidtimebig.tv_usec) then begin
148 //writeln('threaddata is unused, freeing messageevent');
149 athreaddata.messageevent.free;
150 //writeln('freeing thread data object');
151 athreaddata.free;
152 //writeln('deleting thread data object from hashtable');
153 deltree(@threaddata,inttostr(athreaddata.threadid));
154 //writeln('finished deleting thread data');
155 end else begin
156 //writeln('thread data is not unused');
157 end;
158 end;
159
160 function getwindowlongptr(ahwnd:hwnd;nindex:integer) : taddrint;
161 var
162 window : twindow;
163 begin
164 structurelock.acquire;
165 try
166 window := findtree(@windows,inttostr(ahwnd));
167 if window <> nil then begin
168 result := paddrint(taddrint(window.extrawindowmemory)+nindex)^;
169 end else begin
170 result := 0;
171 end;
172 finally
173 structurelock.release;
174 end;
175 end;
176
177 function setwindowlongptr(ahwnd:hwnd;nindex:integer;dwNewLong : taddrint) : taddrint;
178 var
179 window : twindow;
180 begin
181 structurelock.acquire;
182 try
183 window := findtree(@windows,inttostr(ahwnd));
184 if window <> nil then begin
185 result := paddrint(taddrint(window.extrawindowmemory)+nindex)^;
186 paddrint(taddrint(window.extrawindowmemory)+nindex)^ := dwnewlong;
187 end else begin
188 result := 0;
189 end;
190 finally
191 structurelock.release;
192 end;
193
194 end;
195
196
197 function DefWindowProc(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;
198 begin
199 result := 0;
200 end;
201
202 function strdup(s:pchar) : pchar;
203 begin
204 //swriteln('in strdup, about to allocate memory');
205 result := getmem(strlen(s)+1);
206 //swriteln('about to copy string');
207 strcopy(s,result);
208 //swriteln('leaving strdup');
209 end;
210
211 function RegisterClass(const lpWndClass:TWNDCLASS):ATOM;
212 var
213 storedwindowclass:pwndclass;
214 begin
215 structurelock.acquire;
216 try
217 //swriteln('in registerclass, about to check for duplicate window class');
218 storedwindowclass := findtree(@windowclasses, lpwndclass.lpszclassname);
219 if storedwindowclass <> nil then begin
220
221 if comparebyte(storedwindowclass^,lpwndclass,sizeof(twndclass)-sizeof(pchar)-sizeof(pchar)) <> 0 then begin
222 //swriteln('duplicate window class registered with different settings');
223 raise exception.create('duplicate window class registered with different settings');
224 end else begin
225 //swriteln('duplicate window class registered with same settings, tollerated');
226 end;
227 end else begin
228 //swriteln('about to allocate memory for new windowclass');
229 storedwindowclass := getmem(sizeof(twndclass));
230 //swriteln('about to copy windowclass from parameter');
231 move(lpwndclass,storedwindowclass^,sizeof(twndclass));
232 //swriteln('about to copy strings');
233 if lpwndclass.lpszmenuname <> nil then storedwindowclass.lpszmenuname := strdup(lpwndclass.lpszmenuname);
234 if lpwndclass.lpszclassname <> nil then storedwindowclass.lpszclassname := strdup(lpwndclass.lpszclassname);
235 //swriteln('about to add result to list of windowclasses');
236 addtree(@windowclasses,lpwndclass.lpszclassname,storedwindowclass);
237 end;
238 //swriteln('about to return result');
239 result := storedwindowclass;
240 //swriteln('leaving registerclass');
241 finally
242 structurelock.release;
243 end;
244 end;
245
246 function CreateWindowEx(dwExStyle:DWORD; lpClassName:LPCSTR; lpWindowName:LPCSTR; dwStyle:DWORD; X:longint;Y:longint; nWidth:longint; nHeight:longint; hWndParent:HWND; hMenu:HMENU;hInstance:HINST; lpParam:LPVOID):HWND;
247 var
248 wndclass : pwndclass;
249 tm : tthreadmanager;
250 window : twindow;
251 begin
252 structurelock.acquire;
253 try
254 window := twindow.create;
255 window.hwnd := nextwindowhandle;
256 result := window.hwnd;
257 nextwindowhandle := nextwindowhandle + 1;
258 addtree(@windows,inttostr(window.hwnd),window);
259 wndclass := findtree(@windowclasses,lpclassname);
260 window.extrawindowmemory := getmem(wndclass.cbwndextra);
261
262 getthreadmanager(tm);
263 window.threadid := tm.GetCurrentThreadId;
264 window.windowproc := wndclass.lpfnwndproc;
265 finally
266 structurelock.release;
267 end;
268 end;
269 function DestroyWindow(ahWnd:HWND):WINBOOL;
270 var
271 window : twindow;
272 windowthreaddata : tthreaddata;
273 currentmessage : tmessageintransit;
274 prevmessage : tmessageintransit;
275 begin
276 //writeln('started to destroy window');
277 structurelock.acquire;
278 try
279 window := twindow(findtree(@windows,inttostr(ahwnd)));
280 if window <> nil then begin
281 freemem(window.extrawindowmemory);
282 //writeln('aboute to delete window from windows structure');
283 deltree(@windows,inttostr(ahwnd));
284 //writeln('deleted window from windows structure');
285 windowthreaddata := tthreaddata(findtree(@threaddata,inttostr(window.threadid)));
286
287 if windowthreaddata <> nil then begin
288 //writeln('found thread data scanning for messages to clean up');
289 currentmessage := windowthreaddata.messagequeue;
290 prevmessage := nil;
291 while currentmessage <> nil do begin
292 while (currentmessage <> nil) and (currentmessage.msg.hwnd = ahwnd) do begin
293 if prevmessage = nil then begin
294 windowthreaddata.messagequeue := currentmessage.next;
295 end else begin
296 prevmessage.next := currentmessage.next;
297 end;
298 currentmessage.free;
299 if prevmessage = nil then begin
300 currentmessage := windowthreaddata.messagequeue;
301 end else begin
302 currentmessage := prevmessage.next;
303 end;
304 end;
305 if currentmessage <> nil then begin
306 prevmessage := currentmessage;
307 currentmessage := currentmessage.next;
308 end;
309 end;
310 //writeln('deleting thread data structure if it is unused');
311 deletethreaddataifunused(windowthreaddata);
312 end else begin
313 //writeln('there is no thread data to search for messages to cleanup');
314 end;
315 //writeln('freeing window');
316 window.free;
317 result := true;
318 end else begin
319 result := false;
320 end;
321 finally
322 structurelock.release;
323 end;
324 //writeln('window destroyed');
325 end;
326
327
328
329 function PostMessage(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL;
330 var
331 threaddata : tthreaddata;
332 message : tmessageintransit;
333 messagequeueend : tmessageintransit;
334 window : twindow;
335 begin
336 structurelock.acquire;
337 try
338 window := findtree(@windows,inttostr(hwnd));
339 if window <> nil then begin
340 threaddata := findthreaddata(window.threadid);
341 message := tmessageintransit.create;
342 message.msg.hwnd := hwnd;
343 message.msg.message := msg;
344 message.msg.wparam := wparam;
345 message.msg.lparam := lparam;
346 if threaddata.lcorethread then begin
347 //swriteln('posting message to lcore thread');
348 fdwrite(lcorelinkpipesend,message,sizeof(message));
349 end else begin
350 //writeln('posting message to non lcore thread');
351 if threaddata.messagequeue = nil then begin
352 threaddata.messagequeue := message;
353 end else begin
354 messagequeueend := threaddata.messagequeue;
355 while messagequeueend.next <> nil do begin
356 messagequeueend := messagequeueend.next;
357 end;
358 messagequeueend.next := message;
359 end;
360
361 //writeln('message added to queue');
362 if threaddata.waiting then threaddata.messageevent.setevent;
363 end;
364 result := true;
365 end else begin
366 result := false;
367 end;
368 finally
369 structurelock.release;
370 end;
371
372 end;
373
374 function gettickcount : dword;
375 var
376 result64: integer;
377 tv : ttimeval;
378 begin
379 gettimeofday(tv);
380 result64 := (tv.tv_sec*1000)+(tv.tv_usec div 1000);
381 result := result64;
382 end;
383
384 function DispatchMessage(const lpMsg: TMsg): Longint;
385 var
386 timerproc : ttimerproc;
387 window : twindow;
388 windowproc : twndproc;
389 begin
390 ////swriteln('in dispatchmessage, msg.hwnd='+inttohex(taddrint(lpmsg.hwnd),16));
391 if (lpmsg.lparam <> 0) and (lpmsg.message = WM_TIMER) then begin
392 timerproc := ttimerproc(lpmsg.lparam);
393 timerproc(lpmsg.hwnd,lpmsg.message,lpmsg.wparam,gettickcount);
394 result := 0;
395 end else begin
396 structurelock.acquire;
397 try
398 window := findtree(@windows,inttostr(lpmsg.hwnd));
399 //we have to get the window procedure while the structurelock
400 //is still held as the window could be destroyed from another thread
401 //otherwise.
402 windowproc := window.windowproc;
403 finally
404 structurelock.release;
405 end;
406 if window <> nil then begin
407 result := windowproc(lpmsg.hwnd,lpmsg.message,lpmsg.wparam,lpmsg.lparam);
408 end else begin
409 result := -1;
410 end;
411 end;
412 end;
413
414 procedure processtimers;
415 begin
416 end;
417
418 function GetMessageinternal(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT; wremovemsg : UINT;peek:boolean): WINBOOL;
419 var
420 tm : tthreadmanager;
421 threaddata : tthreaddata;
422 message : tmessageintransit;
423 nowtv : ttimeval;
424 timeouttv : ttimeval;
425 timeoutms : int64;
426
427 begin
428 if hwnd <> 0 then raise exception.create('getting messages for an individual window is not supported');
429 if (wmsgfiltermin <> 0) or (wmsgfiltermax <> 0) then raise exception.create('message filtering is not supported');
430 structurelock.acquire;
431 result := true;
432 try
433 getthreadmanager(tm);
434 threaddata := findthreaddata(tm.GetCurrentThreadId);
435 if threaddata.lcorethread then raise exception.create('get/peek message cannot be used in the lcore thread');
436 message := threaddata.messagequeue;
437 gettimeofday(nowtv);
438 while (not peek) and (message=nil) and (not tv_compare(nowtv,threaddata.nexttimer)) do begin
439 threaddata.waiting := true;
440 structurelock.release;
441 if (threaddata.nexttimer.tv_sec = TV_invalidtimebig.tv_sec) and (threaddata.nexttimer.tv_usec = TV_invalidtimebig.tv_usec) then begin
442 threaddata.messageevent.waitfor(INFINITE);
443 end else begin
444
445 timeouttv := threaddata.nexttimer;
446 timeoutms := (timeouttv.tv_sec * 1000)+(timeouttv.tv_usec div 1000);
447 //i'm assuming the timeout is in milliseconds
448 if (timeoutms > maxlongint) then timeoutms := maxlongint;
449 threaddata.messageevent.waitfor(timeoutms);
450
451 end;
452 structurelock.acquire;
453 threaddata.waiting := false;
454 message := threaddata.messagequeue;
455 gettimeofday(nowtv);
456 end;
457 if (message=nil) and tv_compare(nowtv,threaddata.nexttimer) then begin
458 processtimers;
459 end;
460 message := threaddata.messagequeue;
461 if message <> nil then begin
462 lpmsg := message.msg;
463 if wremovemsg=PM_REMOVE then begin
464 threaddata.messagequeue := message.next;
465 message.free;
466 end;
467 end else begin
468 result :=false;
469 end;
470 deletethreaddataifunused(threaddata);
471 finally
472 structurelock.release;
473 end;
474 end;
475
476 function GetMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT): WINBOOL;
477 begin
478 result := getmessageinternal(lpmsg,hwnd,wmsgfiltermin,wmsgfiltermax,PM_REMOVE,false);
479 end;
480
481 function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): WINBOOL;
482 begin
483 result := getmessageinternal(lpmsg,hwnd,wmsgfiltermin,wmsgfiltermax,PM_REMOVE,true);
484 end;
485
486 function SetEvent(hEvent:THevent):WINBOOL;
487 begin
488 hevent.setevent;
489 result := true;
490 end;
491
492 function CreateEvent(lpEventAttributes:PSECURITYATTRIBUTES; bManualReset:WINBOOL; bInitialState:WINBOOL; lpName:pchar):tHevent;
493 begin
494 result := teventobject.create(lpeventattributes,bmanualreset,binitialstate,lpname);
495 end;
496
497 function terminatethread(threadhandle:tthreadid;dummy : integer) : boolean;
498 var
499 tm : tthreadmanager;
500 begin
501 getthreadmanager(tm);
502 tm.killthread(threadhandle);
503 result := true;
504 end;
505
506 function waitforsingleevent(event:thevent;timeout:cardinal) : twaitresult;
507 begin
508 result := event.waitfor(timeout);
509 end;
510
511 procedure removefrombuffer(n : integer; var buffer:string);
512 begin
513 if n=length(buffer) then begin
514 buffer := '';
515 end else begin
516 uniquestring(buffer);
517 move(buffer[n+1],buffer[1],length(buffer)-n);
518 setlength(buffer,length(buffer)-n);
519 end;
520 end;
521
522 type
523 tsc=class
524 procedure available(sender:tobject;error:word);
525 end;
526
527 var
528 recvbuf : string;
529
530 procedure tsc.available(sender:tobject;error:word);
531 var
532 message : tmessageintransit;
533 messagebytes : array[1..sizeof(tmessageintransit)] of char absolute message;
534 i : integer;
535 begin
536 //swriteln('received data on lcorelinkpipe');
537 recvbuf := recvbuf + lcorelinkpiperecv.receivestr;
538 while length(recvbuf) >= sizeof(tmessageintransit) do begin
539 for i := 1 to sizeof(tmessageintransit) do begin
540 messagebytes[i] := recvbuf[i];
541 end;
542 dispatchmessage(message.msg);
543 message.free;
544 removefrombuffer(sizeof(tmessageintransit),recvbuf);
545 end;
546 end;
547
548 procedure init;
549 var
550 tm : tthreadmanager;
551 threaddata : tthreaddata;
552 pipeends : tfildes;
553 sc : tsc;
554 begin
555 structurelock := tcriticalsection.create;
556 getthreadmanager(tm);
557 threaddata := findthreaddata(tm.GetCurrentThreadId);
558 threaddata.lcorethread := true;
559 fppipe(pipeends);
560 lcorelinkpipesend := pipeends[1];
561 lcorelinkpiperecv := tlasio.create(nil);
562 lcorelinkpiperecv.dup(pipeends[0]);
563 lcorelinkpiperecv.ondataavailable := sc.available;
564 recvbuf := '';
565 end;
566
567 var
568 lcorethreadtimers : thashtable;
569 type
570 tltimerformsg = class(tltimer)
571 public
572 hwnd : hwnd;
573 id : taddrint;
574 procedure timer(sender : tobject);
575 end;
576
577 procedure tltimerformsg.timer(sender : tobject);
578 var
579 msg : tmsg;
580 begin
581 ////swriteln('in tltimerformsg.timer');
582 fillchar(msg,sizeof(msg),0);
583 msg.message := WM_TIMER;
584 msg.hwnd := hwnd;
585 msg.wparam := ID;
586 msg.lparam := 0;
587 dispatchmessage(msg);
588 end;
589
590 function SetTimer(ahWnd:HWND; nIDEvent:taddrint; uElapse:UINT; lpTimerFunc:tTIMERPROC):UINT;
591 var
592 threaddata : tthreaddata;
593 ltimer : tltimerformsg;
594 tm : tthreadmanager;
595 window : twindow;
596 begin
597 structurelock.acquire;
598 try
599 window := findtree(@windows,inttostr(ahwnd));
600 if window= nil then raise exception.create('invalid window');
601 threaddata := findthreaddata(window.threadid);
602 finally
603 structurelock.release;
604 end;
605 if threaddata.lcorethread then begin
606 getthreadmanager(tm);
607 if tm.GetCurrentThreadId <> window.threadid then raise exception.create('timers on the lcore thread may only be added and removed from the lcore thread');
608 if ahwnd = 0 then raise exception.create('timers on the lcore thread must be associated with a window handle');
609 if @lptimerfunc <> nil then raise exception.create('seperate timer functions are not supported');
610
611 //remove preexisting timer with same ID
612 killtimer(ahwnd,nIDEvent);
613
614 ltimer := tltimerformsg.create(nil);
615 ltimer.interval := uelapse;
616 ltimer.id := nidevent;
617 ltimer.hwnd := ahwnd;
618 ltimer.enabled := true;
619 ltimer.ontimer := ltimer.timer;
620
621 addtree(@lcorethreadtimers,inttostr(taddrint(ahwnd))+' '+inttostr(nIDEvent),ltimer);
622
623 result := nidevent;
624 end else begin
625 raise exception.create('settimer not implemented for threads other than the lcore thread');
626 end;
627 end;
628
629 function KillTimer(ahWnd:HWND; uIDEvent:taddrint):WINBOOL;
630 var
631 threaddata : tthreaddata;
632 ltimer : tltimerformsg;
633 tm : tthreadmanager;
634 window : twindow;
635 begin
636 structurelock.acquire;
637 try
638 window := findtree(@windows,inttostr(ahwnd));
639 if window= nil then raise exception.create('invalid window');
640 threaddata := findthreaddata(window.threadid);
641 finally
642 structurelock.release;
643 end;
644 if threaddata.lcorethread then begin
645 getthreadmanager(tm);
646 if tm.GetCurrentThreadId <> window.threadid then raise exception.create('timers on the lcore thread may only be added and remove from the lcore thread');
647 if ahwnd = 0 then raise exception.create('timers on the lcore thread must be associated with a window handle');
648 ltimer := tltimerformsg(findtree(@lcorethreadtimers,inttostr(taddrint(ahwnd))+' '+inttostr(uIDEvent)));
649 if ltimer <> nil then begin
650 deltree(@lcorethreadtimers,inttostr(taddrint(ahwnd))+' '+inttostr(uIDEvent));
651 ltimer.free;
652 result := true;
653 end else begin
654 result := false;
655 end;
656 end else begin
657 raise exception.create('settimer not implemented for threads other than the lcore thread');
658 end;
659 end;
660
661 end.

Properties

Name Value
svn:executable

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.22