unitsettc.pas

   1 { Copyright (C) 2005 Bas Steendijk and Peter Green\r
   2   For conditions of distribution and use, see copyright notice in zlib_license.txt\r
   3   which is included in the package\r
   4   ----------------------------------------------------------------------------- }\r
   5 \r
   6 unit Unitsettc;\r
   7 \r
   8 interface\r
   9 \r
  10 procedure settc;\r
  11 procedure unsettc;\r
  12 \r
  13 implementation\r
  14 \r
  15 uses\r
  16   windows,\r
  17   sysutils;\r
  18 \r
  19 var\r
  20   classpriority,threadpriority:integer;\r
  21   refcount:integer=0;\r
  22 \r
  23 procedure settc;\r
  24 var\r
  25   hprocess,hthread:integer;\r
  26 begin\r
  27   if (refcount = 0) then begin\r
  28     hProcess := GetCurrentProcess;\r
  29     hThread := GetCurrentThread;\r
  30     ClassPriority := GetPriorityClass(hProcess);\r
  31     ThreadPriority := GetThreadPriority(hThread);\r
  32     SetPriorityClass(hProcess, REALTIME_PRIORITY_CLASS);\r
  33     SetThreadPriority(hThread, THREAD_PRIORITY_TIME_CRITICAL);\r
  34   end;\r
  35   inc(refcount);\r
  36 end;\r
  37 \r
  38 procedure unsettc;\r
  39 var\r
  40   hprocess,hthread:integer;\r
  41 begin\r
  42   dec(refcount);\r
  43   if (refcount < 0) then refcount := 0;\r
  44   if (refcount = 0) then begin\r
  45     hProcess := GetCurrentProcess;\r
  46     hThread := GetCurrentThread;\r
  47     SetPriorityClass(hProcess, ClassPriority);\r
  48     SetThreadPriority(hThread,  ThreadPriority);\r
  49   end;\r
  50 end;\r
  51 \r
  52 end.\r
  53 \r