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

Annotation of /trunk/lcoremessages.pas

Parent Directory Parent Directory | Revision Log Revision Log


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

1 plugwash 26 { 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 plugwash 1 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 beware 19 baseunix,unix,lcore,unixutil;//,safewriteln;
93 plugwash 1 {$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 beware 19 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