GetPriorityClassとSetPriorityClassで優先順位クラスを取得/設定する

GetPriorityClass and SetPriorityClass

// Delphi 2007 and XE3
// Create form 'TForm1', place 2 ComboBox, 4 Button.
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    Button1: TButton;
    Button2: TButton;
    ComboBox2: TComboBox;
    Button3: TButton;
    Button4: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{$WARN SYMBOL_PLATFORM OFF}

{$IF RTLVersion < 24}
const
  BELOW_NORMAL_PRIORITY_CLASS = $00004000;
  {$EXTERNALSYM ABOVE_NORMAL_PRIORITY_CLASS}
  ABOVE_NORMAL_PRIORITY_CLASS = $00008000;
  {$EXTERNALSYM ABOVE_NORMAL_PRIORITY_CLASS}
{$IFEND}

procedure TForm1.FormCreate(Sender: TObject);
begin

  with ComboBox1.Items do
  begin
    BeginUpdate;
    try
      Clear;
      AddObject(Format('%s (0x%8.8X)',['IDLE',IDLE_PRIORITY_CLASS]),
                TObject(IDLE_PRIORITY_CLASS));
      AddObject(Format('%s (0x%8.8X)',['BELOW_NORMAL',BELOW_NORMAL_PRIORITY_CLASS]),
                TObject(BELOW_NORMAL_PRIORITY_CLASS));
      AddObject(Format('%s (0x%8.8X)',['NORMAL',NORMAL_PRIORITY_CLASS]),
                TObject(NORMAL_PRIORITY_CLASS));
      AddObject(Format('%s (0x%8.8X)',['ABOVE_NORMAL',ABOVE_NORMAL_PRIORITY_CLASS]),
                TObject(ABOVE_NORMAL_PRIORITY_CLASS));
      AddObject(Format('%s (0x%8.8X)',['HIGH',HIGH_PRIORITY_CLASS]),
                TObject(HIGH_PRIORITY_CLASS));
      AddObject(Format('%s (0x%8.8X)',['REALTIME',REALTIME_PRIORITY_CLASS]),
                TObject(REALTIME_PRIORITY_CLASS));

    finally
      EndUpdate;
    end;
  end;

  with ComboBox2.Items do
  begin
    BeginUpdate;
    try
      Clear;
      AddObject(Format('%s (0x%8.8X)',['IDLE',THREAD_PRIORITY_IDLE]),
                TObject(THREAD_PRIORITY_IDLE));
      AddObject(Format('%s (0x%8.8X)',['LOWEST',THREAD_PRIORITY_LOWEST]),
                TObject(THREAD_PRIORITY_LOWEST));
      AddObject(Format('%s (0x%8.8X)',['BELOW_NORMAL',THREAD_PRIORITY_BELOW_NORMAL]),
                TObject(THREAD_PRIORITY_BELOW_NORMAL));
      AddObject(Format('%s (0x%8.8X)',['NORMAL',THREAD_PRIORITY_NORMAL]),
                TObject(THREAD_PRIORITY_NORMAL));
      AddObject(Format('%s (0x%8.8X)',['ABOVE_NORMAL',THREAD_PRIORITY_ABOVE_NORMAL]),
                TObject(THREAD_PRIORITY_ABOVE_NORMAL));
      AddObject(Format('%s (0x%8.8X)',['HIGHEST',THREAD_PRIORITY_HIGHEST]),
                TObject(THREAD_PRIORITY_HIGHEST));
      AddObject(Format('%s (0x%8.8X)',['TIME_CRITICAL',THREAD_PRIORITY_TIME_CRITICAL]),
                TObject(THREAD_PRIORITY_TIME_CRITICAL));

    finally
      EndUpdate;
    end;
  end;

end;

procedure TForm1.Button1Click(Sender: TObject);
var
  PriorityClass: DWORD;
  I: Integer;
begin

  PriorityClass := GetPriorityClass(GetCurrentProcess);

  with ComboBox1 do
  begin
    for I := 0 to Items.Count - 1 do
    begin
      if DWORD(Items.Objects[I]) = PriorityClass then
      begin
        ItemIndex := I;
        Exit;
      end;
    end;

    ItemIndex := -1;
  end;

end;

procedure TForm1.Button2Click(Sender: TObject);
var
  PriorityClass: DWORD;
begin

  with ComboBox1 do
  begin
    if ItemIndex < 0 then
    begin
      Exit;
    end;

    PriorityClass := DWORD(Items.Objects[ItemIndex]);
    Win32Check(SetPriorityClass(GetCurrentProcess,PriorityClass));
  end;

end;

procedure TForm1.Button3Click(Sender: TObject);
var
  PriorityLevel: DWORD;
  I: Integer;
begin

  PriorityLevel := GetThreadPriority(GetCurrentThread);
  if PriorityLevel = THREAD_PRIORITY_ERROR_RETURN then
  begin
    RaiseLastOSError;
  end;

  with ComboBox2 do
  begin
    for I := 0 to Items.Count - 1 do
    begin
      if DWORD(Items.Objects[I]) = PriorityLevel then
      begin
        ItemIndex := I;
        Exit;
      end;
    end;

    ItemIndex := -1;
  end;

end;

procedure TForm1.Button4Click(Sender: TObject);
var
  PriorityLevel: DWORD;
begin

  with ComboBox2 do
  begin
    if ItemIndex < 0 then
    begin
      Exit;
    end;

    PriorityLevel := DWORD(Items.Objects[ItemIndex]);
    Win32Check(SetThreadPriority(GetCurrentThread,PriorityLevel));
  end;
  
end;

end.