unit testprio;
(* ***************************************** *)
(* as FPC have no way to easily set process *)
(* priority without administrative rights on *)
(* most OSes, here is a little trick I give *)
(* in case you need more resources for the *)
(* other processes running on a system *)
(* you can change sleeping values *)
(* I gave 10 and 25 ms because it is Ok for *)
(* me in my intensive computing project *)
(* have fun *)
(* ***************************************** *)
// n.b. at the moment I only slow down main form
// it is possible to make it on each form and
// modal dialogs. furthermore, you can make
// TForm descendants with the slowdown comportment
// this unit is NOT an "expensive computation" demo
// It's a demo for debugging purpose, letting
// you see it works at debugging level by setting
// breakpoints in overriden DefaultHandler and
// SetPriority method
{$mode objfpc}{$H+}
interface
uses
SysUtils, Forms, ComCtrls, Classes;
type
TPriorities = (normal:=0, slow, slower);
{ TForm1 }
TForm1 = class(TForm)
PTrackBar: TTrackBar;
procedure PTrackBarChange(Sender: TObject);
private
FPriority: TPriorities;
procedure SetPriority(aValue: TPriorities);
public
procedure DefaultHandler(var AMessage); override;
property Priority: TPriorities read FPriority write SetPriority;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.PTrackBarChange(Sender: TObject);
begin
case PTrackBar.Position of
1: FPriority := slow;
2: FPriority := slower;
otherwise FPriority := normal;
end;
end;
procedure TForm1.SetPriority(aValue: TPriorities);
begin
FPriority := aValue;
end;
{
Only slow OS handler, not the Dispatch LCL method which
still runs at full speed. then the direct draw access to controls
is not affected.
If you want to slow the LCL too, simply inherit Dispatch method
instead of DefaultHandler
}
procedure TForm1.DefaultHandler(var AMessage);
begin
inherited DefaultHandler(AMessage);
case FPriority of
slow: sleep(10);
slower: sleep(25);
otherwise ;
end;
end;
end.