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

  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
 26unit ChangePriority;
 27
 28{$I JCL.INC}
 29
 30interface
 31
 32uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
 33  Buttons, ExtCtrls;
 34
 35type
 36  TChangePriorityDlg = class(TForm)
 37    OKBtn: TButton;
 38    CancelBtn: TButton;
 39    PriorityRadioGroup: TRadioGroup;
 40    procedure FormCreate(Sender: TObject);
 41    procedure OKBtnClick(Sender: TObject);
 42  private
 43    FProcessID: DWORD;
 44    procedure SetProcessID(const Value: DWORD);
 45  public
 46    property ProcessID: DWORD write SetProcessID;
 47  end;
 48
 49var
 50  ChangePriorityDlg: TChangePriorityDlg;
 51
 52implementation
 53
 54{$R *.DFM}
 55
 56uses
 57  ToolsUtils;
 58
 59resourcestring
 60  sCantChange = 'Couldn''t change process priority';
 61
 62{ TChangePriorityDlg }
 63
 64procedure TChangePriorityDlg.SetProcessID(const Value: DWORD);
 65var
 66  Handle: THandle;
 67  Priority: DWORD;
 68  I: Integer;
 69begin
 70  FProcessID := Value;
 71  Handle := OpenProcess(PROCESS_ALL_ACCESS{PROCESS_QUERY_INFORMATION}, False, FProcessID);
 72  if Handle <> 0 then
 73  begin
 74    Priority := GetPriorityClass(Handle);
 75    CloseHandle(Handle);
 76  end else Priority := 0;
 77  I := PriorityRadioGroup.Items.IndexOfObject(Pointer(Priority));
 78  if I = -1 then I := 1;
 79  PriorityRadioGroup.ItemIndex := I;
 80end;
 81
 82procedure TChangePriorityDlg.FormCreate(Sender: TObject);
 83begin
 84  with PriorityRadioGroup.Items do
 85  begin
 86    BeginUpdate;
 87    AddObject('&Idle', Pointer(IDLE_PRIORITY_CLASS));
 88    AddObject('&Normal', Pointer(NORMAL_PRIORITY_CLASS));
 89    AddObject('&High', Pointer(HIGH_PRIORITY_CLASS));
 90    AddObject('&Realtime', Pointer(REALTIME_PRIORITY_CLASS));
 91    EndUpdate;
 92  end;
 93end;
 94
 95procedure TChangePriorityDlg.OKBtnClick(Sender: TObject);
 96var
 97  Handle: THandle;
 98  Priority: DWORD;
 99  Res: Boolean;
100begin
101  with PriorityRadioGroup do Priority := DWORD(Items.Objects[ItemIndex]);
102  Handle := OpenProcess(PROCESS_ALL_ACCESS{PROCESS_SET_INFORMATION}, False, FProcessID);
103  if Handle <> 0 then
104  begin
105    Res := SetPriorityClass(Handle, Priority);
106    CloseHandle(Handle);
107  end else Res := False;
108  if Res then
109    ModalResult := mrOk
110  else
111    MessBox(sCantChange, MB_ICONERROR);
112end;
113
114end.