-{ 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
unit wcore;\r
\r
{\r
end;\r
\r
tltimer=class(tlcomponent)\r
+ private\r
+ fenabled : boolean;\r
+ procedure setenabled(newvalue : boolean);\r
public\r
ontimer:tnotifyevent;\r
initialevent:boolean;\r
initialdone:boolean;\r
prevtimer:tltimer;\r
nexttimer:tltimer;\r
- interval:integer; {miliseconds, default 1000}\r
- enabled:boolean;\r
+ interval:integer; {milliseconds, default 1000}\r
nextts:integer;\r
+ property enabled:boolean read fenabled write setenabled;\r
constructor create(aowner:tcomponent);override;\r
destructor destroy;override;\r
end;\r
procedure disconnecttasks(aobj:tobject);\r
procedure exitmessageloop;\r
procedure processmessages;\r
+procedure wcoreinit;\r
\r
var\r
- onshutdown:procedure(s:string);\r
+ onshutdown:procedure(s:ansistring);\r
\r
implementation\r
\r
var\r
hwndwcore:hwnd;\r
firsttimer:tltimer;\r
- timesubstract:integer;\r
+ timesubtract:integer;\r
firsttask,lasttask,currenttask:tltask;\r
\r
procedure tlcomponent.release;\r
\r
{------------------------------------------------------------------------------}\r
\r
+procedure tltimer.setenabled(newvalue : boolean);\r
+begin\r
+ fenabled := newvalue;\r
+ nextts := 0;\r
+ initialdone := false;\r
+end;\r
+\r
constructor tltimer.create;\r
begin\r
inherited create(AOwner);\r
end;\r
\r
tvnow := timegettime;\r
- if (tvnow and ((-1) shl rollover_bits)) <> timesubstract then begin\r
+ if (tvnow and ((-1) shl rollover_bits)) <> timesubtract then begin\r
currenttimer := firsttimer;\r
while assigned(currenttimer) do begin\r
dec(currenttimer.nextts,(1 shl rollover_bits));\r
currenttimer := currenttimer.nexttimer;\r
end;\r
- timesubstract := tvnow and ((-1) shl rollover_bits);\r
+ timesubtract := tvnow and ((-1) shl rollover_bits);\r
end;\r
tvnow := tvnow and ((1 shl rollover_bits)-1);\r
\r
end else begin\r
currenttasklocal := currenttask; //needed in case called from a task\r
end;\r
- // note i don't bother to sestroy the links here as that will happen when\r
+ // note i don't bother to destroy the links here as that will happen when\r
// the list of tasks is processed anyway\r
while assigned(currenttasklocal) do begin\r
if currenttasklocal.obj = aobj then begin\r
lpszMenuName : nil;\r
lpszClassName : 'wcoreClass');\r
\r
-procedure messageloop;\r
-var\r
- MsgRec : TMsg;\r
+procedure wcoreinit;\r
begin\r
-\r
if Windows.RegisterClass(MyWindowClass) = 0 then halt;\r
//writeln('about to create wcore handle, hinstance=',hinstance);\r
hwndwcore := CreateWindowEx(WS_EX_TOOLWINDOW,\r
{$endif}\r
\r
\r
+end;\r
+\r
+procedure messageloop;\r
+var\r
+ MsgRec : TMsg;\r
+\r
+begin\r
+\r
while GetMessage(MsgRec, 0, 0, 0) do begin\r
TranslateMessage(MsgRec);\r
DispatchMessage(MsgRec);\r
\r
function ProcessMessage : Boolean;\r
var\r
- Msg : TMsg;\r
+ MsgRec : TMsg;\r
begin\r
Result := FALSE;\r
- if PeekMessage(Msg, hwndwcore, 0, 0, PM_REMOVE) then begin\r
+ if PeekMessage(MsgRec, 0, 0, 0, PM_REMOVE) then begin\r
Result := TRUE;\r
- DispatchMessage(Msg);\r
+ TranslateMessage(MsgRec);\r
+ DispatchMessage(MsgRec);\r
end;\r
end;\r
\r
\r
\r
end.\r
+\r