lcorelocalips: fix multiple windows 9x and NT4 support issues. rename function gethos...

[lcore.git] / wcore.pas

diff --git a/wcore.pas b/wcore.pas
old mode 100755 (executable)
new mode 100644 (file)
index f88aa53..2c07d50
--- a/wcore.pas
+++ b/wcore.pas
@@ -1,8 +1,3 @@
-{ 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
 unit wcore;\r
 \r
 {\r


@@ -39,7 +34,7 @@ interface
       initialdone:boolean;\r
       prevtimer:tltimer;\r
       nexttimer:tltimer;\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
       nextts:integer;\r
       property enabled:boolean read fenabled write setenabled;\r
       constructor create(aowner:tcomponent);override;\r


@@ -63,9 +58,10 @@ procedure addtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
 procedure disconnecttasks(aobj:tobject);\r
 procedure exitmessageloop;\r
 procedure processmessages;\r
 procedure disconnecttasks(aobj:tobject);\r
 procedure exitmessageloop;\r
 procedure processmessages;\r

+procedure wcoreinit;\r

 \r
 var\r
 \r
 var\r

-  onshutdown:procedure(s:string);\r
+  onshutdown:procedure(s:ansistring);\r

 \r
 implementation\r
 \r
 \r
 implementation\r
 \r


@@ -83,7 +79,7 @@ const
 var\r
   hwndwcore:hwnd;\r
   firsttimer:tltimer;\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
   firsttask,lasttask,currenttask:tltask;\r
 \r
 procedure tlcomponent.release;\r


@@ -148,13 +144,13 @@ begin
   end;\r
 \r
   tvnow := timegettime;\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
     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;\r
   tvnow := tvnow and ((1 shl rollover_bits)-1);\r
 \r


@@ -221,7 +217,7 @@ begin
     end else begin\r
       currenttasklocal := currenttask; //needed in case called from a task\r
     end;\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
     // the list of tasks is processed anyway\r
     while assigned(currenttasklocal) do begin\r
       if currenttasklocal.obj = aobj then begin\r


@@ -317,11 +313,8 @@ var
                                  lpszMenuName  : nil;\r
                                  lpszClassName : 'wcoreClass');\r
 \r
                                  lpszMenuName  : nil;\r
                                  lpszClassName : 'wcoreClass');\r
 \r

-procedure messageloop;\r
-var\r
-  MsgRec : TMsg;\r
+procedure wcoreinit;\r

 begin\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
   if Windows.RegisterClass(MyWindowClass) = 0 then halt;\r
   //writeln('about to create wcore handle, hinstance=',hinstance);\r
   hwndwcore := CreateWindowEx(WS_EX_TOOLWINDOW,\r


@@ -344,6 +337,14 @@ begin
   {$endif}\r
 \r
 \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
   while GetMessage(MsgRec, 0, 0, 0) do begin\r
     TranslateMessage(MsgRec);\r
     DispatchMessage(MsgRec);\r


@@ -364,12 +365,13 @@ end;
 \r
 function ProcessMessage : Boolean;\r
 var\r
 \r
 function ProcessMessage : Boolean;\r
 var\r

-    Msg : TMsg;\r
+    MsgRec : TMsg;\r

 begin\r
     Result := FALSE;\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
       Result := TRUE;\r

-      DispatchMessage(Msg);\r
+      TranslateMessage(MsgRec);\r
+      DispatchMessage(MsgRec);\r

     end;\r
 end;\r
 \r
     end;\r
 end;\r
 \r


@@ -380,3 +382,4 @@ end;
 \r
 \r
 end.\r
 \r
 \r
 end.\r

+\r