喫茶XRAY [Mr.XRAY掲示板]

[ 動的配列でメモリー不足の回避 ]
https://www.petitmonte.com/bbs/answers?question_id=29968

某掲示板で上のような書き込みがありました．
で，やってみました．
すご～く時間がかかります．経験しておくといいと思います (笑)

unit Unit1;

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  PRData = ^RData;
  RData = Record
    denc : Word;
    od : Single;
    norm1 : Single;
    disp1 : Byte;
    lvl1 : Word;
    dose : Single;
    norm2 : Single;
    disp2 : Byte;
    lvl2 : Word;
  end;

  RMTX  = Record
    ARY : Array [ 1 .. 6 ] of RData;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    function UsesMemory: UInt64;
  end;

var
  Form1: TForm1;

type
  ARY = Array of Array of Array of RMTX;

implementation

{$R *.dfm}

uses
  psAPI;

//=============================================================================
//  多次元配列のメモリ確保状況確認テスト
//  事実上 4 次元の配列
//  非常に時間がかかる
//
//  [動作確認]
//  Windows 10 ビルド 19043 + Delphi XE5(UP2) Pro VCL-64
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSize    : Integer;
  LAry1 : ARY;
  LAry2 : ARY;
  LAry3 : ARY;
begin
  LSize := 512;
  SetLength(LAry1, LSize, LSize, LSize);
  SetLength(LAry2, LSize, LSize, LSize);
  SetLength(LAry3, LSize, LSize, LSize);

  Memo1.Lines.Add(FormatFloat('###,##0 KB', UsesMemory div 1024));
  Memo1.Lines.Add('End');
end;

//=============================================================================
//  自プロセスのメモリ使用量
//=============================================================================
function TForm1.UsesMemory: UInt64;
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;

    Result := LMemUsed;
  finally
    FreeMem(LProcessMem);
  end;
end;

end.