1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253 |
- { Copyright (C) 2005 Bas Steendijk and Peter Green
- For conditions of distribution and use, see copyright notice in zlib_license.txt
- which is included in the package
- ----------------------------------------------------------------------------- }
-
- unit Unitsettc;
-
- interface
-
- procedure settc;
- procedure unsettc;
-
- implementation
-
- uses
- windows,
- sysutils;
-
- var
- classpriority,threadpriority:integer;
- refcount:integer=0;
-
- procedure settc;
- var
- hprocess,hthread:integer;
- begin
- if (refcount = 0) then begin
- hProcess := GetCurrentProcess;
- hThread := GetCurrentThread;
- ClassPriority := GetPriorityClass(hProcess);
- ThreadPriority := GetThreadPriority(hThread);
- SetPriorityClass(hProcess, REALTIME_PRIORITY_CLASS);
- SetThreadPriority(hThread, THREAD_PRIORITY_TIME_CRITICAL);
- end;
- inc(refcount);
- end;
-
- procedure unsettc;
- var
- hprocess,hthread:integer;
- begin
- dec(refcount);
- if (refcount < 0) then refcount := 0;
- if (refcount = 0) then begin
- hProcess := GetCurrentProcess;
- hThread := GetCurrentThread;
- SetPriorityClass(hProcess, ClassPriority);
- SetThreadPriority(hThread, ThreadPriority);
- end;
- end;
-
- end.
-
|