* * *

Author Topic: easy priority trick  (Read 258 times)

sam707

  • Guest
easy priority trick
« on: May 17, 2018, 04:46:51 pm »
Code: Pascal  [Select]
  1. unit testprio;
  2. (* ***************************************** *)
  3. (* as FPC have no  way to easily set process *)
  4. (* priority without administrative rights on *)
  5. (* most OSes, here is  a little trick I give *)
  6. (* in case  you need more resources  for the *)
  7. (* other processes running on a system       *)
  8. (* you  can  change  sleeping values         *)
  9. (* I gave  10 and 25 ms because it is Ok for *)
  10. (* me in my intensive computing project      *)
  11. (* have fun                                  *)
  12. (* ***************************************** *)
  13.  
  14. // n.b. at the moment I only slow down main form
  15. // it is possible to make it on each form and
  16. // modal dialogs. furthermore, you can make
  17. // TForm descendants with the slowdown comportment
  18.  
  19. // this unit is NOT an "expensive computation" demo
  20. // It's a demo for debugging purpose, letting
  21. // you see it works at debugging level by setting
  22. // breakpoints in overriden DefaultHandler and
  23. // SetPriority method
  24.  
  25. {$mode objfpc}{$H+}
  26.  
  27. interface
  28.  
  29. uses
  30.   SysUtils, Forms, ComCtrls, Classes;
  31.  
  32. type
  33.  
  34.   TPriorities = (normal:=0, slow, slower);
  35.  
  36.   { TForm1 }
  37.  
  38.   TForm1 = class(TForm)
  39.     PTrackBar: TTrackBar;
  40.     procedure PTrackBarChange(Sender: TObject);
  41.   private
  42.     FPriority: TPriorities;
  43.     procedure SetPriority(aValue: TPriorities);
  44.   public
  45.     procedure DefaultHandler(var AMessage); override;
  46.     property Priority: TPriorities read FPriority write SetPriority;
  47.   end;
  48.  
  49. var
  50.   Form1: TForm1;
  51.  
  52. implementation
  53.  
  54. {$R *.lfm}
  55.  
  56. { TForm1 }
  57.  
  58. procedure TForm1.PTrackBarChange(Sender: TObject);
  59. begin
  60.   case PTrackBar.Position of
  61.     1: FPriority := slow;
  62.     2: FPriority := slower;
  63.     otherwise FPriority := normal;
  64.   end;
  65. end;
  66.  
  67. procedure TForm1.SetPriority(aValue: TPriorities);
  68. begin
  69.   FPriority := aValue;
  70. end;
  71.  
  72. {
  73.   Only slow OS handler, not the Dispatch LCL method which
  74.   still runs at full speed. then the direct draw access to controls
  75.   is not affected.
  76.   If you want to slow the LCL too, simply inherit Dispatch method
  77.   instead of DefaultHandler
  78. }
  79. procedure TForm1.DefaultHandler(var AMessage);
  80. begin
  81.   inherited DefaultHandler(AMessage);
  82.   case FPriority of
  83.     slow: sleep(10);
  84.     slower: sleep(25);
  85.     otherwise ;
  86.   end;
  87. end;
  88.  
  89. end.
  90.  
« Last Edit: May 17, 2018, 05:00:42 pm by sam707 »

sam707

  • Guest
Re: easy priority trick
« Reply #1 on: May 17, 2018, 04:54:51 pm »
attached file = working prioritize template

 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus