Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2007年11月30日] [更新 2015年09月27日] Delphi サンプルプログラム集
473_メモリの使用状況を表示
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
473_MemoryInfo.zip [1,085 KB] 2015年09月27日版 (EXE 同梱)



  • 2011年09月25日
  • 8 GB 以上のメモリに対応するために,使用する関数を GlobalMemoryStatusEx に変更
  • 対象 OS から Windows 9X 関係を除外
  • OS のバージョンはバージョン番号のみの表示とした
  • [02_自プロセスのメモリ使用量を表示] を追加
  • 2015年09月27日
  • Windows 7 U64(SP1) + Delphi XE(UP1) Pro で動作確認




01_メモリの使用状況を表示


起動すると,GlobalMemoryStatusEx 関数を使用して,物理メモリと仮想メモリの使用状況を表示します.使用状況は,TTimer のインターバル値の設定時間間隔で更新します.


図1
設計時画面
  • TGauge の Progress を 50% にしているのは,文字の表示確認のため
図2
実行画面

リスト1
メモリの使用状況を表示
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    GroupBox2: TGroupBox;
    GroupBox1: TGroupBox;
    lbl_lbl12: TStaticText;
    lbl_OSBuildNo: TStaticText;
    Gauge_Physical: TGauge;
    lbl_lbl21: TStaticText;
    lblText22: TStaticText;
    lbl_lbl23: TStaticText;
    lbl_TotalPhysical: TStaticText;
    lbl_UsedPhysical: TStaticText;
    GroupBox3: TGroupBox;
    Gauge_Virtual: TGauge;
    lbl_lbl31: TStaticText;
    lbl_lbl32: TStaticText;
    lbl_lbl33: TStaticText;
    lbl_TotalVirtual: TStaticText;
    lbl_UsedVirtual: TStaticText;
    Timer1: TTimer;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure MemoryInfoDisplay;
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム作成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer1.Enabled  := False;

  Gauge_Physical.Progress := 0;
  Gauge_Virtual.Progress  := 0;

  //ゲージの色を変えてみる
  Gauge_Virtual.ForeColor := clGreen;

  lbl_OSBuildNo.Caption     := '';
  lbl_TotalPhysical.Caption := '';
  lbl_UsedPhysical.Caption  := '';
  lbl_TotalVirtual.Caption  := '';
  lbl_UsedVirtual.Caption   := '';
end;

//=============================================================================
//  フォームを表示したらOSのバージョンとメモリの使用状況を取得して表示
//  OSのバージョンはTOSVersionInfoEx構造体(Windows.pas)で定義してある
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  LOSVerInfo : TOSVersionInfoEx;
begin
  //OSのバージョン情報を取得
  LOSVerInfo.dwOSVersionInfoSize := SizeOf(LOSVerInfo);
  GetVersionEx(LOSVerInfo);

  //OSのバージョンの判定
  //Win9X系は除外
  if LOSVerInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then begin

    Timer1.Enabled  := True;
    Timer1.Interval := 200;

    //OSバージョン
    lbl_OSBuildNo.Caption := IntToStr(LOSVerInfo.dwMajorVersion) + '.'
                           + IntToStr(LOSVerInfo.dwMinorVersion) + '.'
                           + IntToStr((LOSVerInfo.dwBuildNumber));

    //メモリの状況を取得して表示
    MemoryInfoDisplay;
  end;

  //最前面に表示
  SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
end;

//=============================================================================
//  Timer1のOnTimerイベント処理
//  Timer1.Intervael(ミリセコンド)で指定した時間間隔で発生するイベント
//  メモリの使用状況を更新表示する
//=============================================================================
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  MemoryInfoDisplay;
end;

//-----------------------------------------------------------------------------
//  メモリの使用状況を取得して表示
//-----------------------------------------------------------------------------
procedure TForm1.MemoryInfoDisplay;
var
  LMemInfo    : TMemoryStatusEx;
  LValueTotal : Int64;
  LValueUsed  : Int64;
begin
  //メモリの状況を取得
  LMemInfo.dwLength := SizeOf(LMemInfo);
  GlobalMemoryStatusEx(LMemInfo);

  //全物理メモリ容量
  LValueTotal := LMemInfo.ullTotalPhys div 1024;
  lbl_TotalPhysical.Caption := FormatFloat('###,##0 KB', LValueTotal);

  //使用中の物理メモリ容量
  LValueUsed := (LMemInfo.ullTotalPhys - LMemInfo.ullAvailPhys) div 1024;
  lbl_UsedPhysical.Caption := FormatFloat('###,##0 KB', LValueUsed);

  //ゲージに表示
  Gauge_Physical.Progress := LMemInfo.dwMemoryLoad;

  //全仮想メモリ容量
  LValueTotal := LMemInfo.ullTotalPageFile div 1024;
  lbl_TotalVirtual.Caption := FormatFloat('###,##0 KB', LValueTotal);

  //使用中の仮想メモリ容量
  LValueUsed := (LMemInfo.ullTotalPageFile - LMemInfo.ullAvailPageFile) div 1024;
  lbl_UsedVirtual.Caption := FormatFloat('###,##0 KB', LValueUsed);

  //ゲージに表示
  Gauge_Virtual.Progress := Trunc((LValueUsed / LValueTotal) * 100);;
end;

end.




02_自プロセスのメモリ使用量を表示


GetProcessMemoryInfo 関数を使用して,自プロセスのメモリの使用量を表示します.
使用量は Timer のインターバル値の設定時間間隔で更新します.


図3
設計時画面
図4
実行画面
  • TProgressBar はパーセント表示

リスト2
自プロセスのメモリの使用量を表示
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    GroupBox2: TGroupBox;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    StaticText3: TStaticText;
    StaticText4: TStaticText;
    Timer1: TTimer;
    ProgressBar1: TProgressBar;
    procedure FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure MemoryInfoDisplay;
  private
    { Private 宣言 }
    MemValue : Int64;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  psAPI;

{$R *.dfm}

//=============================================================================
//  フォームを表示したらOSのバージョンと
//  物理メモリ量の値を取得して表示
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  LMemInfo : TMemoryStatusEx;
begin
  Timer1.Enabled  := True;
  Timer1.Interval := 200;

  //メモリの状況を取得
  LMemInfo.dwLength := SizeOf(LMemInfo);
  GlobalMemoryStatusEx(LMemInfo);

  //全物理メモリ容量
  MemValue := LMemInfo.ullTotalPhys;
  StaticText2.Caption := FormatFloat('###,##0 KB', MemValue div 1024);

  //ProgressBar1のMaxプロパティはIntegerなのでメモリ量の値をセットすると
  //オーバーになってしまうことがある
  ProgressBar1.Max := 100;

  //メモリの使用量を取得して表示
  MemoryInfoDisplay;

  //最前面に表示
  SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
end;

//=============================================================================
//  Timer1のOnTimerイベント処理
//  Timer1.Intervael(ミリセコンド)で指定した時間間隔で発生するイベント
//  メモリの使用量を更新表示する
//=============================================================================
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  MemoryInfoDisplay;
end;

//-----------------------------------------------------------------------------
//  このプロセスのメモリの使用量を取得して表示
//
//  PPROCESS_MEMORY_COUNTERSの使用にはusesにpsAPIが必要
//-----------------------------------------------------------------------------
procedure TForm1.MemoryInfoDisplay;
var
  LSize       : Cardinal;
  LProcessMem : PPROCESS_MEMORY_COUNTERS;
  LMemUsed    : Cardinal;
begin
  LSize := SizeOf(_PROCESS_MEMORY_COUNTERS);
  GetMem(LProcessMem, LSize);
  try
    LProcessMem^.cb := LSize;
    //GetCurrentProcessを他のプロセスのハンドルにすれば,そのプロセスのメモリ
    //使用量が取得できる
    if GetProcessMemoryInfo(GetCurrentProcess, LProcessMem, LSize) then begin
      LMemUsed := LProcessMem^.WorkingSetSize;
    end else begin
      LMemUsed := 0;
    end;
    ProgressBar1.Position := Round(LMemUsed / MemValue * 100);
    StaticText4.Caption := FormatFloat('###,##0 KB', LMemUsed div 1024);
  finally
    FreeMem(LProcessMem);
  end;
end;

end.