/jcl/examples/windows/delphitools/toolhelpview/ChangePriority.pas

https://github.com/the-Arioch/jcl · Pascal · 114 lines · 72 code · 15 blank · 27 comment · 6 complexity · e584112be7126504700b0fa92e4b145a MD5 · raw file

  1. {**************************************************************************************************}
  2. { }
  3. { Project JEDI Code Library (JCL) - Delphi Tools }
  4. { }
  5. { The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
  6. { you may not use this file except in compliance with the License. You may obtain a copy of the }
  7. { License at http://www.mozilla.org/MPL/ }
  8. { }
  9. { Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
  10. { ANY KIND, either express or implied. See the License for the specific language governing rights }
  11. { and limitations under the License. }
  12. { }
  13. { The Original Code is ChangePriority.pas. }
  14. { }
  15. { The Initial Developer of the Original Code is Petr Vones. Portions created by Petr Vones are }
  16. { Copyright (C) of Petr Vones. All Rights Reserved. }
  17. { }
  18. { Contributor(s): }
  19. { }
  20. {**************************************************************************************************}
  21. { }
  22. { Last modified: $Date$ }
  23. { }
  24. {**************************************************************************************************}
  25. unit ChangePriority;
  26. {$I JCL.INC}
  27. interface
  28. uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  29. Buttons, ExtCtrls;
  30. type
  31. TChangePriorityDlg = class(TForm)
  32. OKBtn: TButton;
  33. CancelBtn: TButton;
  34. PriorityRadioGroup: TRadioGroup;
  35. procedure FormCreate(Sender: TObject);
  36. procedure OKBtnClick(Sender: TObject);
  37. private
  38. FProcessID: DWORD;
  39. procedure SetProcessID(const Value: DWORD);
  40. public
  41. property ProcessID: DWORD write SetProcessID;
  42. end;
  43. var
  44. ChangePriorityDlg: TChangePriorityDlg;
  45. implementation
  46. {$R *.DFM}
  47. uses
  48. ToolsUtils;
  49. resourcestring
  50. sCantChange = 'Couldn''t change process priority';
  51. { TChangePriorityDlg }
  52. procedure TChangePriorityDlg.SetProcessID(const Value: DWORD);
  53. var
  54. Handle: THandle;
  55. Priority: DWORD;
  56. I: Integer;
  57. begin
  58. FProcessID := Value;
  59. Handle := OpenProcess(PROCESS_ALL_ACCESS{PROCESS_QUERY_INFORMATION}, False, FProcessID);
  60. if Handle <> 0 then
  61. begin
  62. Priority := GetPriorityClass(Handle);
  63. CloseHandle(Handle);
  64. end else Priority := 0;
  65. I := PriorityRadioGroup.Items.IndexOfObject(Pointer(Priority));
  66. if I = -1 then I := 1;
  67. PriorityRadioGroup.ItemIndex := I;
  68. end;
  69. procedure TChangePriorityDlg.FormCreate(Sender: TObject);
  70. begin
  71. with PriorityRadioGroup.Items do
  72. begin
  73. BeginUpdate;
  74. AddObject('&Idle', Pointer(IDLE_PRIORITY_CLASS));
  75. AddObject('&Normal', Pointer(NORMAL_PRIORITY_CLASS));
  76. AddObject('&High', Pointer(HIGH_PRIORITY_CLASS));
  77. AddObject('&Realtime', Pointer(REALTIME_PRIORITY_CLASS));
  78. EndUpdate;
  79. end;
  80. end;
  81. procedure TChangePriorityDlg.OKBtnClick(Sender: TObject);
  82. var
  83. Handle: THandle;
  84. Priority: DWORD;
  85. Res: Boolean;
  86. begin
  87. with PriorityRadioGroup do Priority := DWORD(Items.Objects[ItemIndex]);
  88. Handle := OpenProcess(PROCESS_ALL_ACCESS{PROCESS_SET_INFORMATION}, False, FProcessID);
  89. if Handle <> 0 then
  90. begin
  91. Res := SetPriorityClass(Handle, Priority);
  92. CloseHandle(Handle);
  93. end else Res := False;
  94. if Res then
  95. ModalResult := mrOk
  96. else
  97. MessBox(sCantChange, MB_ICONERROR);
  98. end;
  99. end.