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

Annotation of /trunk/lmessages.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (hide annotations)
Fri Mar 28 02:26:58 2008 UTC (12 years, 7 months ago) by plugwash
File size: 21554 byte(s)
initial import

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