Delphi Tips

Get CPU Usage

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1 : TLabel;
    procedure Label1Click(Sender: TObject);
    procedure Label1DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1 : TForm1;
  stop  : boolean;

implementation

{$R *.DFM}

function GetCPUSpeed : Double;
const
  DelayTime = 500; // measure time in ms
var
  TimerHi, TimerLo : DWORD;
  PriorityClass, Priority : Integer;
begin
  PriorityClass := GetPriorityClass(GetCurrentProcess);
  Priority := GetThreadPriority(GetCurrentThread);

  SetPriorityClass(GetCurrentProcess,
                     REALTIME_PRIORITY_CLASS);
  SetThreadPriority(GetCurrentThread,
                     THREAD_PRIORITY_TIME_CRITICAL);

  Sleep(10);
  asm
    dw 310Fh // rdtsc
    mov TimerLo, eax
    mov TimerHi, edx
  end;
  Sleep(DelayTime);
  asm
    dw 310Fh // rdtsc
    sub eax, TimerLo
    sbb edx, TimerHi
    mov TimerLo, eax
    mov TimerHi, edx
  end;

  SetThreadPriority(GetCurrentThread, Priority);
  SetPriorityClass(GetCurrentProcess, PriorityClass);

  Result := TimerLo / (1000.0 * DelayTime);
end;


procedure TForm1.Label1Click(Sender: TObject);
begin
Stop := False;
  while not Stop do
  begin
    label1.Caption := Format('CPU speed: %f MHz',
                                       [GetCPUSpeed]);
    Application.ProcessMessages;
  end;
end;


procedure TForm1.Label1DblClick(Sender: TObject);
begin
  Stop := True;
end;

end.

 

Back to Index of Tips