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 で動作確認
|
起動すると,GlobalMemoryStatusEx 関数を使用して,物理メモリと仮想メモリの使用状況を表示します.使用状況は,TTimer のインターバル値の設定時間間隔で更新します. |
|
図1
設計時画面
- TGauge の Progress を 50% にしているのは,文字の表示確認のため
|
|
図2
実行画面 |
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.
GetProcessMemoryInfo 関数を使用して,自プロセスのメモリの使用量を表示します.
使用量は Timer のインターバル値の設定時間間隔で更新します. |
|
図3
設計時画面 |
|
図4
実行画面
|
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.
|