-{ 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
initialdone:boolean;\r
prevtimer:tltimer;\r
nexttimer:tltimer;\r
- interval:integer; {miliseconds, default 1000}\r
+ interval:integer; {milliseconds, default 1000}\r
nextts:integer;\r
property enabled:boolean read fenabled write setenabled;\r
constructor create(aowner:tcomponent);override;\r
procedure disconnecttasks(aobj:tobject);\r
procedure exitmessageloop;\r
procedure processmessages;\r
+procedure wcoreinit;\r
\r
var\r
onshutdown:procedure(s:ansistring);\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
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
var\r
MsgRec : TMessage;\r
a:integer;\r
- handled:boolean;\r
begin\r
Result := 0; // This means we handled the message\r
\r
- handled := false;\r
-\r
{MsgRec.hwnd := ahWnd;}\r
MsgRec.wParam := awParam;\r
MsgRec.lParam := alParam;\r
\r
- if (ahwnd = hwndwcore) then begin\r
- dotasks;\r
- case auMsg of\r
+ dotasks;\r
+ case auMsg of\r
{$ifndef threadtimer}\r
WM_TIMER: begin\r
- handled := true;\r
if msgrec.wparam = timerid_wcore then begin\r
a := wcore_timehandler;\r
killtimer(hwndwcore,timerid_wcore);\r
{WINMSG_TASK:dotasks;}\r
\r
WM_CLOSE: begin\r
- handled := true;\r
+ {}\r
end;\r
WM_DESTROY: begin\r
- handled := true;\r
+ {}\r
end;\r
- end;\r
+ else\r
+ Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)\r
end;\r
-\r
- if not handled then Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)\r
end;\r
\r
\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, 0, 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