implementation

uses
  plCommMem;

{$R *.dfm}

const
  MAPNAME = 'BASIC_MEMORY_MAPPED_FILE_NAME';

//=============================================================================
//  フォーム生成時の処理
//  共有メモリの生成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // 対象の変数のサイズの共有メモリを指定
  // 実際の共有メモリのサイズはこれより大きくなる 
  // ここで指定した共有メモリ名以外ではこの共有メモリにアクセスできない 
  TplCommMem.Create(SizeOf(Double), MAPNAME);
end;

//=============================================================================
//  フォーム破棄の処理
//  共有メモリを使用しなくなったら必ずの解放破棄する
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  TplCommMem.Free(MAPNAME);
end;

//=============================================================================
//  共有メモリにテータを書き込む
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcData : Double;
begin
  LSrcData := 123.56;
  // 共有メモリの先頭 (0) から SizeOf(LSrcData) バイトのデータを書き込む
  TplCommMem.Write(MAPNAME, @LSrcData, 0, SizeOf(LSrcData));
end;

//=============================================================================
//  共有メモリからデータを取得する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LDstData : Double;
begin
  // 共有メモリの先頭 (0) から SizeOf(LDstData) バイトのデータを読み出す
  TplCommMem.Read(MAPNAME, @LDstData, 0, SizeOf(LDstData));

  MessageBox(Handle, PChar(FloatToStr(LDstData)), '取得結果', MB_ICONINFORMATION);
end;

implementation

uses
  plCommMem;

{$R *.dfm}

type
  PCommMemData = ^TCommMemData;
  TCommMemData = record
    IntVal  : Integer;
    RealVal : Double;
  end;

const
  MAPNAME = 'TEST_RECORD_MEMORY_MAPPED_FILE_NAME';  

//=============================================================================
//  フォーム生成時の処理
//  共有メモリの生成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
   Caption := '共有メモリ作成アプリ';
  TplCommMem.Create(SizeOf(TCommMemData), MAPNAME);
end;

//=============================================================================
//  フォーム破棄の処理
//  共有メモリの解放
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  TplCommMem.Free(MAPNAME);
end;

//=============================================================================
//  共有メモリにテータを書き込む
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LMemData : TCommMemData;
  LText    : string;
begin
  LMemData.IntVal := 12345;
  LMemData.RealVal := 256.128;

  // 第 3 引数と第 4 引数の合計が全データのサイズを超えないこと
  if not TplCommMem.Write(MAPNAME, @LMemData, 0, SizeOf(LMemData)) then begin
    LText := '共有メモリにアクセスできませんでした．';
    MessageBox(Handle, PChar(LText), '書き込み失敗', MB_ICONWARNING);
  end;
end;

//=============================================================================
//  共有メモリからデータを取得する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LMemData : TCommMemData;
  LText    : string;
begin
  // 第 3 引数と第 4 引数の合計が全データのサイズを超えないこと
  if TplCommMem.Read(MAPNAME, @LMemData, 0, SizeOf(LMemData)) then begin
    LText := IntToStr(LMemData.IntVal) + sLineBreak + FloatToStr(LMemData.RealVal);
    MessageBox(Handle, PChar(LText), '取得結果', MB_ICONINFORMATION);
  end else begin
    LText := '共有メモリにアクセスできませんでした．';
    MessageBox(Handle, PChar(LText), '取得結果', MB_ICONWARNING);
  end;
end;

implementation

uses
  plCommMem;

{$R *.dfm}

type
  PCommMemData = ^TCommMemData;
  TCommMemData = record
    IntVal  : Integer;
    RealVal : Double;
  end;

const
  MAPNAME = 'TEST_RECORD_MEMORY_MAPPED_FILE_NAME';  

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
   Caption := '共有メモリ利用専用アプリ';
end;

//=============================================================================
//  共有メモリにテータを書き込む
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LMemData : TCommMemData;
  LText    : string;
begin
  LMemData.IntVal := 11111;
  LMemData.RealVal := 999.999;

  // 第 3 引数と第 4 引数の合計が全データのサイズを超えないこと
  if not TplCommMem.Write(MAPNAME, @LMemData, 0, SizeOf(LMemData)) then begin
    LText := '共有メモリにアクセスできませんでした．';
    MessageBox(Handle, PChar(LText), '書き込み失敗', MB_ICONWARNING);
  end;
end;

//=============================================================================
//  共有メモリからデータを取得する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LMemData : TCommMemData;
  LText    : string;
begin
  // 第 3 引数と第 4 引数の合計が全データのサイズを超えないこと
  if TplCommMem.Read(MAPNAME, @LMemData, 0, SizeOf(LMemData)) then begin
    LText := IntToStr(LMemData.IntVal) + sLineBreak + FloatToStr(LMemData.RealVal);
    MessageBox(Handle, PChar(LText), '取得結果', MB_ICONINFORMATION);
  end else begin
    LText := '共有メモリにアクセスできませんでした．';
    MessageBox(Handle, PChar(LText), '取得結果', MB_ICONWARNING);
  end;
end;

  TplCommMem.Create(SizeOf(TCommMemData), MAPNAME);
  if GetLastError = ERROR_ALREADY_EXISTS then begin
    ShowMessage('この名前の共有メモリは作成済みです．');
  end;

implementation

uses
  plCommMem;

{$R *.dfm}

const
  MAPNAME = 'TEST_BITMAP_PLUNIT_MEMORY_MAPPED_FILE_NAME';
  MAPSISE = 4096 * 10000;

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := '共有メモリ作成アプリ';
  // 十分なサイズのメモリを確保して共有メモリを作成
  TplCommMem.Create(MAPSISE, MAPNAME);
end;

//=============================================================================
//  フォーム破棄時の処理
//  共有メモリを解放
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  TplCommMem.Free(MAPNAME);
end;

//=============================================================================
//  共有メモリに画像のデータを書き込む
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  WriteDataToCommMem('../../Images/503_Alpha.bmp');
end;

//=============================================================================
//  共有メモリに別の画像のデータを書き込む
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  WriteDataToCommMem('../../Images/Lenna.jpg');
end;

//-----------------------------------------------------------------------------
//  引数で指定るす画像ファイルを共有メモリに書き込む手続き
//
//  共有メモリから読み出す時，画像ファイルのサイズを取得したいので
//  最初に画像ファイルのバイトサイズを書き込む
//-----------------------------------------------------------------------------
procedure TForm1.WriteDataToCommMem(AFilePath: string);
var
  LMemStream : TMemoryStream;
  LImgSize   : Integer;
begin
  LMemStream := TMemoryStream.Create;
  try
    // 画像ファイルをメモリストリームに読み込む
    LMemStream.LoadFromFile(AFilePath);
    // 画像ファイルのバイサイズ
    LImgSize := LMemStream.Size;

    // 画像ファイルサイズとデータを共有メモリに書き込む
    TplCommMem.Write(MAPNAME, @LImgSize, 0, SizeOf(LImgSize));
    TplCommMem.Write(MAPNAME, LMemStream.Memory, SizeOf(LImgSize), LImgSize);
  finally
    FreeAndNil(LMemStream);
  end;
end;

implementation

uses
  plCommMem;

{$R *.dfm}

const
  MAPNAME = 'TEST_BITMAP_PLUNIT_MEMORY_MAPPED_FILE_NAME';
  MAPSISE = 4096 * 10000;

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := '共有メモリ利用専用アプリ';
end;

//=============================================================================
//  共有メモリから画像のデータを読み込む
//
//  画像のバイトサイズを取得して，それをメモリストリームのサイズにする
//  共有メモリのデータをそのメモリストリームに書き込む
//  TBitmap.LoadFromStream でそのメモリストリームを読み込む
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBmpSize   : Integer;
  LMemStream : TMemoryStream;
  LWICImage  : TWICImage;
begin
  Image1.Picture.Assign(nil);

  // 画像のバイトサイズを共有メモリから取得
  if not TplCommMem.Read(MAPNAME, @LBmpSize, 0, SizeOf(LBmpSize)) then begin
    MessageBox(Handle, '共有メモリアクセスに失敗しました．', '取得結果', MB_ICONWARNING);
    Exit;
  end else begin
    if LBmpSize = 0 then begin
     MessageBox(Handle, '共有メモリにデータがありません．', '取得結果', MB_ICONWARNING);
      Exit;
    end;
  end;


  LWICImage  := TWICImage.Create;
  LMemStream := TMemoryStream.Create;
  try
    // 画像のデータを格納するメモリストリームのサイズを設定 (メモリの確保)
    LMemStream.Size := LBmpSize;
    // 画像のデータを共有メモリから読み込んでメモリストリームに書き込む
    if TplCommMem.Read(MAPNAME, LMemStream.Memory, SizeOf(LBmpSize), LBmpSize) then begin
      // TWICImage に読み込んで TImage にその画像を描画
      LWICImage.LoadFromStream(LMemStream);
      Image1.Picture.Assign(LWICImage);
     end;
  finally
    FreeAndNil(LWICImage);
    FreeAndNil(LMemStream);
  end;
end;

uses
  plCommMem;

{$R *.dfm}

const
  MAPNAME = 'TEST_STRING_MEMORY_MAPPED_FILE_NAME';
  MAPSISE = 4096 * 10000;

//=============================================================================
//  フォーム生成時の処理
//  共有メモリの生成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // 十分なサイズの共有メモリを確保
  TplCommMem.Create(MAPSISE, MAPNAME);
end;

//=============================================================================
//  フォーム破棄の処理
//  共有メモリの解放
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  TplCommMem.Free(MAPNAME);
end;

//=============================================================================
//  共有メモリにテータを書き込む
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStrData : string;
  LByteLen : Integer;
begin
  LStrData := '日本語 ABC 文字列';
  LByteLen := Length(LStrData) * SizeOf(Char);

  // 文字列のバイトサイズを共有メモリに書き込む
  TplCommMem.Write(MAPNAME, @LByteLen, 0, SizeOf(LByteLen));

  // 文字列をバイトデータとして共有メモリに書き込む
  TplCommMem.Write(MAPNAME, @LStrData[1], SizeOf(LByteLen), LByteLen);
end;

//=============================================================================
//  共有メモリからデータを取得する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LStrData : string;
  LByteLen : Integer;
begin
  // 文字列のバイトサイズを共有メモリから取得
  TplCommMem.Read(MAPNAME, @LByteLen, 0, SizeOf(LByteLen));

  // 取得する文字列の長さを設定 (メモリの確保)
  SetLength(LStrData, LByteLen div SizeOf(Char));
  // 共有メモリから文字列のデータを取得
  TplCommMem.Read(MAPNAME, @LStrData[1], SizeOf(LByteLen), LByteLen);

  MessageBox(Handle, PChar(LStrData), '取得結果', MB_ICONINFORMATION);
end;

implementation

{$R *.dfm}

const
  MAPNAME = 'TEST_BITMAP_MEMORY_MAPPED_FILE_NAME';

var
  FhCommMem : THandle;

//=============================================================================
//  フォーム破棄時の処理
//  共有メモリの破棄
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  CloseHandle(FhCommMem);
end;

//=============================================================================
//  共有メモリを作成してビットマップを書き込む
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap     : TBitmap;
  LBytesStream : TBytesStream;
  LBmpSize     : Integer;
  LAllocSize   : DWORD;
  LhMapObj     : THandle;
  LpBaseAddr   : Pointer;
begin
  // TBitmap を生成して画像を読み込んでメモリストリームに格納
  LBitmap      := TBitmap.Create;
  LBytesStream := TBytesStream.Create;
  try
    LBitmap.LoadFromFile('../Images/503_Alpha.bmp');
    LBitmap.SaveToStream(LBytesStream);

    // ビットマップのバイトサイズ
    LBmpSize := LBytesStream.Size;
    // 共有メモリ (メモリマップドファイル ) のサイズ
    LAllocSize := SizeOf(LBmpSize) + LBmpSize;


    // 共有メモリ作成
    FhCommMem := CreateFileMapping(INVALID_HANDLE_VALUE,
                                   nil,
                                   PAGE_READWRITE,
                                   0,
                                   LAllocSize,
                                   PChar(MAPNAME));


    // メモリマップドファイルを開く
    LhMapObj := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MAPNAME));
    if LhMapObj <> 0 then begin
      LpBaseAddr := MapViewOfFile(LhMapObj, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  //
      // 共有メモリにデータを書き込む
      CopyMemory(LpBaseAddr, @LbmpSize, SizeOf(LBmpSize));
      CopyMemory(Pointer(NativeUInt(LpBaseAddr) + SizeOf(LBmpSize)),
                 @LBytesStream.Bytes[0],
                 LBmpSize);

      // メモリマップドファイルを閉じる
      UnmapViewOfFile(LpBaseAddr);
      CloseHandle(LhMapObj);
    end;
  finally
    FreeAndNil(LBitmap);
    FreeAndNil(LBytesStream);
  end;
end;

//=============================================================================
//  共有メモリからビットマップを取得
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LBmpSize     : Integer;
  LhMapObj     : THandle;
  LpBaseAddr   : Pointer;
  LBitmap      : TBitmap;
  LBytesStream : TBytesStream;
begin
  // メモリマップドファイルを開く
  LhMapObj := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MAPNAME));
  if LhMapObj<> 0 then begin
    LpBaseAddr := MapViewOfFile(LhMapObj, FILE_MAP_ALL_ACCESS, 0, 0, 0);

    // 共有メモリからビットマップのバイトサイズの値を取得
    CopyMemory(@LBmpSize, LpBaseAddr, SizeOf(LBmpSize));


    LBitmap      := TBitmap.Create;
    LBytesStream := TBytesStream.Create;
    try
      LBytesStream.Size := LBmpSize;
      // 共有メモリのビットマップデータをメモリストリームに書き込む
      CopyMemory(@LBytesStream.Bytes[0],
                 Pointer(NativeUInt(LpBaseAddr) + SizeOf(LBmpSize)),
                 LBmpSize);
      LBitmap.LoadFromStream(LBytesStream);
      Image1.Picture.Assign(LBitmap);
    finally
      FreeAndNil(LBitmap);
      FreeAndNil(LBytesStream);
    end;

    // メモリマップドファイルを閉じる
    UnmapViewOfFile(LpBaseAddr);
    CloseHandle(LhMapObj);
  end;
end;

var
  // 途中は省略
  LMemoryInfo : MEMORY_BASIC_INFORMATION;
  LSystemInfo : SYSTEM_INFO;
  LText       : string;
begin
      // 途中は省略

      // 共有メモリのサイズ取得用
      VirtualQuery(LpBaseAddr, LMemoryInfo, SizeOf(LMemoryInfo));
      // ページサイズの値取得用
      GetSystemInfo(LSystemInfo);

      LText := 'LBmpSize : '   + IntToStr(LBmpSize) + sLineBreak
             + 'LAllocSize : ' + IntToStr(LAllocSize) + sLineBreak
             + 'RegionSize : ' + IntToStr(LMemoryInfo.RegionSize) + sLineBreak
             + 'PageSize : '   + IntToStr(LSystemInfo.dwPageSize);

      ShowMessage(LText);

      // 以降省略

implementation

uses
  Winapi.UrlMon;

{$R *.dfm}

//=============================================================================
//  ファイルの MIME タイプを調べる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LMemStream : TMemoryStream;
  LImgType   : string;
begin
  LMemStream  := TMemoryStream.Create;
  try
    // ファイルのデータをメモリストリームに格納
    LMemStream.LoadFromFile('../../Images/Lenna.bmp');
    // MIME タイプを調べる
    LImgType := GetFileMimeType(LMemStream);

    MessageBox(Handle, PChar(LImgType), 'ファイル形式', MB_ICONINFORMATION);
  finally
    FreeAndNil(LMemStream);
  end;
end;

//-----------------------------------------------------------------------------
//  ファイルのデータを格納したメモリストリームから MIMETYPE を取得する関数
//
//  以下の場合の戻値は application/octet-stream
//  ファイルの形式が不明
//  対象のファイル形式には MIME タイプが定義されていない
//
//  FindMimeFromData の使用には uses に Winapi.UrlMon が必要
//-----------------------------------------------------------------------------
function TForm1.GetFileMimeType(AStream: TMemoryStream): string;
const
  MAX_COUNT = 256;
var
  LMimeType  : PWideChar;
  LReadSize  : Cardinal;
begin
  Result := '';

  // 調査に使用するバイト数を設定
  if AStream.Size > MAX_COUNT then begin
    LReadSize := MAX_COUNT;
  end else begin
    LReadSize := AStream.Size;
  end;

  LMimeType := nil;
  if FindMimeFromData(nil,
                      nil,
                      AStream.Memory,
                      LReadSize,
                      nil,
                      0,
                      LMimeType,
                      0) = S_OK then begin
    Result := LMimeType;
  end;
end;

//=============================================================================
//  画像ファイルのデータから MIME タイプを調べる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LWICImage  : TWICImage;
  LMemStream : TMemoryStream;
  LImgFormat : string;
  LFileType  : string;
  LText      : string;
begin
  LWICImage  := TWICImage.Create;
  LMemStream := TMemoryStream.Create;
  try
    // 画像フィルを読み込んでメモリストリームに格納
    // TWICImage は各種の画像形式を扱える
    LWICImage.LoadFromFile('../../Images/Lenna.png');
    Image1.Picture.Assign(LWICImage);
    LWICImage.SaveToStream(LMemStream);

    // MIME タイプを調べる
    LFileType := GetFileMimeType(LMemStream);

    // TWICImage.ImageFormat プロパティは画像の形式
    // その列挙型 (TWICImageFormat 型) の値を文字列に変換
    // uses に System.TypInfo が必要
    LImgFormat := GetEnumName(TypeInfo(TWICImageFormat), Ord(LWICImage.ImageFormat));

    // 結果を表示
    LText := LFileType + sLineBreak + LImgFormat;
    MessageBox(Handle, PChar(LText), '画像形式', MB_ICONINFORMATION);
  finally
    FreeAndNil(LWICImage);
    FreeAndNil(LMemStream);
  end;
end;

//=============================================================================
//  String 型の文字列の MIME タイプを調べる
//  ファイルのテータではないので application/octet-stream (不明) となる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcText   : string;
  LMemStream : TMemoryStream;
  LFileType  : string;
begin
  LMemStream := TMemoryStream.Create;
  try
    LSrcText := '日本語 ABC 文字列';
    LMemStream.Size := Length(LSrcText) * SizeOf(Char);
    Move(LSrcText[1], LMemStream.Memory^, LMemStream.Size);

    RichEdit1.Lines.LoadFromStream(LMemStream, TEncoding.Unicode);

    LFileType := GetFileMimeType(LMemStream);
    MessageBox(Handle, PChar(LFileType), 'ファイル形式', MB_ICONINFORMATION);


    // TRichEdit に表示した文字列をメモリストリームに保存
    // そのストリームの MIME タイプはリッチテキスト形式となる
    LMemStream.Clear;
    RichEdit1.Lines.SaveToStream(LMemStream);
    LFileType := GetFileMimeType(LMemStream);
    MessageBox(Handle, PChar(LFileType), 'ファイル形式', MB_ICONINFORMATION);
  finally
    FreeAndNil(LMemStream);
  end;
end;

//=============================================================================
//  リッチテキストファイル (RTF) の MIME タイプを調べる
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LMemStream : TMemoryStream;
  LFileType  : string;
begin
  RichEdit1.Lines.LoadFromFile(ExpandFileName( '../../Images/RichText.RTF'));

  LMemStream := TMemoryStream.Create;
  try
    RichEdit1.Lines.SaveToStream(LMemStream);

    LFileType := GetFileMimeType(LMemStream);
    MessageBox(Handle, PChar(LFileType), 'ファイル形式', MB_ICONINFORMATION);
  finally
    FreeAndNil(LMemStream);
  end;   
end;

//-----------------------------------------------------------------------------
//  ファイルのフォーマット識別子でファイルの形式を取得する関数
// フォーマット識別子はマジックナンバーとも呼ばれている
//  代表的な画像形式のみ判定するコード
//
//  アイコンルだけはファイルヘッダの情報で判定
//-----------------------------------------------------------------------------
function TForm1.GetImageType(AStream: TMemoryStream): string;
type
  //アイコンファイルのヘッダ部
  PIconFileHeader = ^TIconFileHeader;
  TIconFileHeader = packed record
    idReserved : Word;
    idType     : Word;
    idCount    : Word;
  end;
var
  LImgType    : AnsiString;
  LIconHeader : TIconFileHeader;
begin
  // 文字列の長さを設定して (メモリの確保) 先頭から指定バイト数を代入
  // LImgType は AnsiString 型の文字列
  SetLength(LImgType, 32);
  Move(AStream.Memory^, LImgType[1], Length(LImgType) - 1);

  // TBitmap で扱えるデータ
  if Copy(LImgType, 1, 2) = 'BM' then begin
    LImgType := 'TBitmap';
  end else

  // TGIFImage で扱えるデータ(uses に Vcl.Imaging.GIFImg が必要)
  if Copy(LImgType, 1, 6) = 'GIF89a' then begin
    LImgType := 'TGIFImage';
  end else

  // TJPEGImage で扱えるデータ (uses に Vcl.Imaging.jpeg が必要)
  if (Byte(LImgType[1]) = $FF) and (Byte(LImgType[2]) = $D8) then begin
    if Copy(LImgType, 7, 4) = 'JFIF' then begin
      LImgType := 'TJPEGImage';
    end;
  end else

  // TPngImage で扱えるデータ(uses に Vcl.Imaging.pngimage が必要)
  if (Byte(LImgType[1]) = $89) then begin
    if Copy(LImgType, 2, 3) = 'PNG' then begin
      LImgType := 'TPngImage';
    end;
  end else begin

    // ico ファイルのファイルヘッダ部分に相当するデータを取得
    AStream.Position := 0;
    AStream.Read(LIconHeader, SizeOf(LIconHeader));
    if (LIconHeader.idReserved = 0) and (LIconHeader.idtype = 1) then begin
      // count は格納されているアイコン画像の数
      LImgType := 'TIcon  count : ' + IntToStr(LIconHeader.idCount);
    end else begin
      LImgType := '';
    end;
  end;

  Result := LImgType;
end;

//=============================================================================
//  ビットマップファイルヘッダ部の構造体にはファイルサイズのメンバがある
//  ただし正確とは限らない．この値が 0 のビットマップもある
//  
//  1 度 TBitmap に読み込むと正しい値になる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LMemStream  : TMemoryStream;
  LFileName   : string;
  LFileSize   : DWORD;
  LText       : string;
begin
  LFileName := ExpandFileName('../../Images/Lenna.bmp');

  LMemStream  := TMemoryStream.Create;
  try
    // ファイルのデータをメモリストリームに格納
    LMemStream.LoadFromFile(LFileName);

    // ビットマップ画像ファイルサイズを取得
    // 3 バイト目から 4 バイトの符号なしの整数値として格納されている
    LMemStream.Position := 2;
    LMemStream.Read(LFileSize, SizeOf(LFileSize));

    LText := IntToStr(LFileSize) + sLineBreak
           + IntToStr(LMemStream.Size);
    MessageBox(Handle, PChar(LText), 'ファイルサイズ', MB_ICONINFORMATION);
  finally
    FreeAndNil(LMemStream);
  end;
end;

  // データ数もレコード型にしておく 
  TCommMemFileHeader = record
    Count : Integer;  // データ数
  end;

  TCommMemHeader = record
    Offset : Cardinal;              // 書き込んだ位置（先頭からのオフセットバイト）
    Size : Cardinal;                // データのバイト数
    dType : array[0..32] of Char;   // データの形式 (種類)．格納内容は任意
  end;
  PCommMemHeader = ^TCommMemHeader;

  // 上のレコード型の動的配列
  TCommMemHeaderArray = array of TCommMemHeader;
  PCommMemHeaderArray = ^TCommMemHeaderArray;

implementation

uses
  plCommMem;

{$R *.dfm}

const
  MAPNAME = 'TEST_HEADER_MEMORY_MAPPED_FILE_NAME';
  MAPSISE = 4096 * 10000;

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := '共有メモリ作成アプリ';
  // 十分なサイズの共有メモリを作成
  TplCommMem.Create(MAPSISE, MAPNAME);
end;

//=============================================================================
//  フォーム破棄時の処理
//  共有メモリを解放
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  TplCommMem.Free(MAPNAME);
end;

//=============================================================================
//  複数のデータを共有メモリに書き込む
//  専用の関数を作成して使用
//
//  TCommMemHeaderArray は TCommMemHeader 型の動的配列
//  TCommMemHeader は各データの情報を格納するレコード型
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LInfoArray : TCommMemHeaderArray;
  LString    : string;
  LNumValue  : Double;
  LMemStream : TMemoryStream;
begin
  // 動的配列の要素数を設定してヘッダ部を初期化
  WriteCommMemHeader(MAPNAME, LInfoArray, 4);


  LMemStream := TMemoryStream.Create;
  try
    // String 型の文字列を共有メモリに書き込む
    LString := '日本語 ABC 文字列';
    StringToMemStream(LString, LMemStream);
    WriteCommMemData(MAPNAME, LMemStream, LInfoArray, 'STRING');

    // 画像ファイルを読み込んで共有メモリに書き込む
    LMemStream.LoadFromFile('../../Images/AParrots.png');
    WriteCommMemData(MAPNAME, LMemStream, LInfoArray, 'PNG');

    // リッチテキストファイルを読み込んで共有メモリに書き込む
    LMemStream.LoadFromFile('../../Images/RichText.RTF');
    WriteCommMemData(MAPNAME, LMemStream, LInfoArray, 'RICHTEXT');

    // 倍精度実数型の数値を共有メモリに書き込む
    // 必ずメモリストリームのサイズを設定する
    // 設定しないと現在のサイズがそのまま使われてしまう
    LNumValue := 123.456;
    LMemStream.Size := SizeOf(LNumValue);
    LMemStream.WriteData(LNumValue);
    WriteCommMemData(MAPNAME, LMemStream, LInfoArray, 'DOUBLE');
 finally
    FreeAndNil(LMemStream);
  end;
end;

implementation

uses
  plCommMem;

{$R *.dfm}

const
  MAPNAME = 'TEST_HEADER_MEMORY_MAPPED_FILE_NAME';
  MAPSISE = 4096 * 10000;

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := '共有メモリ利用専用アプリ';
end;

//=============================================================================
//  複数のデータを書き込んだ共有メモリからデータを読み込む
//  専用の関数を作成して使用
//
//  TCommMemHeaderArray は TCommMemHeader 型の動的配列
//  TCommMemHeader は各データの情報を格納するレコード型
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LDataCount : Cardinal;
  LInfoArray : TCommMemHeaderArray;
  LMemStream : TMemoryStream;
  LDataType  : string;
begin
  Image1.Picture.Assign(nil);
  RichEdit1.Lines.Clear;

  // ヘッダ部からデータ数とデータ情報を格納しているレコード型の全テータを取得
  if not ReadCommMemHeader(MAPNAME, LInfoArray, LDataCount) then Exit;
  if (LDataCount = 0) then Exit;


  LMemStream := TMemoryStream.Create;
  try
    // 2 番目のデータを取り出す
    ReadCommMemData(MAPNAME, LMemStream, LInfoArray, 1, LDataType);
    ShowCommMemData(LMemStream, LDataType);

    // 3 番目のデータを取り出す
    ReadCommMemData(MAPNAME, LMemStream, LInfoArray, 2,  LDataType);
    ShowCommMemData(LMemStream, LDataType);

    // 1 番目のデータを取り出す
    ReadCommMemData(MAPNAME, LMemStream, LInfoArray, 0, LDataType);
    ShowCommMemData(LMemStream, LDataType);

    // 4 番目のデータを取り出す
    ReadCommMemData(MAPNAME, LMemStream, LInfoArray, 3, LDataType);
    ShowCommMemData(LMemStream, LDataType);
  finally
    FreeAndNil(LMemStream);
  end;
end;

//-----------------------------------------------------------------------------
//  データの形式によって処理を分ける
//-----------------------------------------------------------------------------
procedure TForm1.ShowCommMemData(AStream: TMemoryStream; ADataType: string);
var
  LWICImage : TWICImage;
  LDataStr  : string;
  LNumValue : Double;
begin
  if (ADataType = '') or (AStream.Size = 0) then Exit;

  if ADataType = 'PNG' then begin
    /// PNG 画像の時は TWICImage に読み込んでそれを TImage に描画
    LWICImage := TWICImage.Create;
    try
      LWICImage.LoadFromStream(AStream);
      Image1.Picture.Assign(LWICImage);
    finally
      FreeAndNil(LWICImage);
    end;
  end else
  if ADataType = 'RICHTEXT' then begin
    /// リッチテキストの時は TRichEdit に読み込んで表示
    RichEdit1.Lines.LoadFromStream(AStream);
  end else
  if ADataType = 'STRING' then begin
    /// String 型の文字列の時はメモリストリームのデータを文字列変数に代入
    LDataStr := MemStreamToString(AStream);
    MessageBox(Handle, PChar(LDataStr), '取得結果', MB_ICONINFORMATION);
  end else
  if ADataType = 'DOUBLE' then begin
    /// Double 型の数値の場合
    AStream.ReadData(LNumValue);
    MessageBox(Handle, PChar(FloatToStr(LNumValue)), '取得結果', MB_ICONINFORMATION);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  LDataCount : Cardinal;
  LInfoArray : TCommMemHeaderArray;
  LMemStream : TMemoryStream;
  LDataType  : string;
  LIndex     : Integer;
begin
  Image1.Picture.Assign(nil);
  RichEdit1.Lines.Clear;

  // ヘッダ部からデータ数とデータ情報を格納しているレコード型の全テータを取得
  if not ReadCommMemHeader(MAPNAME, LInfoArray, LDataCount) then Exit;
  if (LDataCount = 0) then Exit;


  LMemStream := TMemoryStream.Create;
  try
    // 共有メモリから順番にデータを取り出す
    for LIndex := 0 to High(LInfoArray) do begin
      ReadCommMemData(MAPNAME, LMemStream, LInfoArray, Lindex, LDataType);
      ShowCommMemData(LMemStream, LDataType);
    end;
  finally
    FreeAndNil(LMemStream);
  end;
end;

function ReadCommMemData(AMapName: string; ADstStream: TMemoryStream;
  AInfo: TCommMemHeader; var ADataType: string): Boolean;
begin
  ADstStream.Size := AInfo.Size;
  Result := TplcommMem.Read(AMapName, ADstStream.Memory, AInfo.Offset, AInfo.Size);
  ADataType := AInfo.dType;
  ADstStream.Position := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  LDataCount : Cardinal;
  LInfoArray : TCommMemHeaderArray;
  LMemStream : TMemoryStream;
  LDataType  : string;
  LIndex     : Integer;
begin
  Image1.Picture.Assign(nil);
  RichEdit1.Lines.Clear;

  // ヘッダ部からデータ数とデータ情報を格納しているレコード型の全テータを取得
  if not ReadCommMemHeader(MAPNAME, LInfoArray, LDataCount) then Exit;
  if (LDataCount = 0) then Exit;


  LMemStream := TMemoryStream.Create;
  try
    // 共有メモリから順番にデータを取り出す
    for LIndex := 0 to High(LInfoArray) do begin
      ReadCommMemData(MAPNAME, LMemStream, LInfoArray[Lindex], LDataType);
      ShowCommMemData(LMemStream, LDataType);
    end;
  finally
    FreeAndNil(LMemStream);
  end;
end;

implementation

uses
  plCommMem;

{$R *.dfm}

const
  MAPNAME = 'TEST_1dimArray-Double_MEMORY_MAPPED_FILE_NAME';
  MAPSISE = 4096 * 10000;

  FColCount = 5;

type
  TDoubleArray = array [0..FColCount - 1] of Double;

//=============================================================================
//  フォーム生成時の処理
//  共有メモリの生成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // 十分なサイズの共有メモリを確保
  TplCommMem.Create(MAPSISE, MAPNAME);

  Memo1.ScrollBars := ssVertical;
  Memo1.Font.Size  := 11;
  Memo1.Font.Name  := 'Courier New';
end;

//=============================================================================
//  フォーム破棄の処理
//  共有メモリの解放
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  TplCommMem.Free(MAPNAME);
end;

//=============================================================================
//  共有メモリにテータを書き込む
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcDblArray : TDoubleArray;
  LCol         : Integer;
  LInfoArray   : TCommMemHeaderArray;
  LMemStream   : TMemoryStream;
begin
  // テスト用のデータを配列要素に代入
  for LCol := 0 to FColCount - 1 do begin
    LSrcDblArray[LCol] := 100 + (LCol + 1) / 10.0;
  end;

  // 共有メモリのヘッダ部を初期化
  WriteCommMemHeader(MAPNAME, LInfoArray, 1);


  LMemStream := TMemoryStream.Create;
  try
    // メモリストリームに配列データを格納
    LMemStream.Size := FColCount * SizeOf(Double);
    LMemStream.Write(@LSrcDblArray, LMemStream.Size);

    // 配列データを格納したメモリストリームを共有メモリに書き込む
    WriteCommMemData(MAPNAME, LMemStream, LInfoArray, '1dimArray-Double');
  finally
    FreeAndNil(LMemStream);
  end;
end;

//=============================================================================
//  共有メモリからデータを取得する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LDataCount   : Cardinal;
  LInfoArray   : TCommMemHeaderArray;
  LMemStream   : TMemoryStream;
  LDataType    : string;
  LDstDblArray : TDoubleArray;
  LCol         : Integer;
  LResText     : string;
begin
  Memo1.Lines.Clear;

  // 共有メモリのヘッダ部を取得
  if not ReadCommMemHeader(MAPNAME, LInfoArray, LDataCount) then Exit;
  if (LDataCount = 0) then Exit;


  LMemStream := TMemoryStream.Create;
  try
    // 共有メモリのデータをメモリストリームに読み出す
    ReadCommMemData(MAPNAME, LMemStream, LInfoArray, 0, LDataType);

    if LDataType = '1dimArray-Double' then begin
      // メモリストリームのデータを配列要素に読み込む
      LMemStream.Position := 0;
      LMemStream.Read(LDstDblArray, LMemStream.Size);

      // 取得したデータを表示
      LResText := '';
      for LCol := 0 to FColCount - 1 do begin
        LResText := LResText + FormatFloat('   000.0', LDstDblArray[LCol]);
      end;
      Memo1.Lines.Add(LResText);
    end;
  finally
    FreeAndNil(LMemStream);
  end;
end;

implementation

uses
  plCommMem;

{$R *.dfm}

const
  MAPNAME = 'TEST_2dimArray-integer_MEMORY_MAPPED_FILE_NAME';
  MAPSISE = 4096 * 10000;

  FRowCount = 2;
  FColCount = 5;

type
  TIntArray = array [0..FRowCount - 1, 0..FColCount - 1] of Integer;

//=============================================================================
//  フォーム生成時の処理
//  共有メモリの生成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // 十分なサイズの共有メモリを確保
  TplCommMem.Create(MAPSISE, MAPNAME);

  Memo1.ScrollBars := ssVertical;
  Memo1.Font.Size  := 11;
  Memo1.Font.Name  := 'Courier New';
end;

//=============================================================================
//  フォーム破棄の処理
//  共有メモリの解放
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  TplCommMem.Free(MAPNAME);
end;

//=============================================================================
//  共有メモリにテータを書き込む
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcIntArray : TIntArray;
  LRow         : Integer;
  LCol         : Integer;
  LInfoArray   : TCommMemHeaderArray;
  LMemStream   : TMemoryStream;
begin
  // テスト用のデータを配列要素に代入
  for LRow := 0 to FRowCount - 1 do begin
    for LCol := 0 to FColCount - 1 do begin
      LSrcIntArray[LRow][LCol] := (LRow + 1) * 1000 + (LCol + 1);
    end;
  end;

  // 共有メモリのヘッダ部を初期化
  WriteCommMemHeader(MAPNAME, LInfoArray, 1);


  LMemStream := TMemoryStream.Create;
  try
    // メモリストリームに配列データを格納
    LMemStream.Size := FRowCount * FColCount * SizeOf(Integer);
    LMemStream.Write(@LSrcIntArray, LMemStream.Size);

    // 配列データを格納したメモリストリームを共有メモリに書き込む
    WriteCommMemData(MAPNAME, LMemStream, LInfoArray, '2dimArray-integer');
  finally
    FreeAndNil(LMemStream);
  end;
end;

//=============================================================================
//  共有メモリからデータを取得する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LDataCount   : Cardinal;
  LInfoArray   : TCommMemHeaderArray;
  LMemStream   : TMemoryStream;
  LDataType    : string;
  LDstIntArray : TIntArray;
  LRow         : Integer;
  LCol         : Integer;
  LResText     : string;
begin
  Memo1.Lines.Clear;

  // 共有メモリのヘッダ部を取得
  if not ReadCommMemHeader(MAPNAME, LInfoArray, LDataCount) then Exit;
  if (LDataCount = 0) then Exit;


  LMemStream := TMemoryStream.Create;
  try
    // 共有メモリのデータをメモリストリームに読み出す
    ReadCommMemData(MAPNAME, LMemStream, LInfoArray, 0, LDataType);

    if LDataType = '2dimArray-integer' then begin
      // メモリストリームのデータを配列要素に読み込む
      LMemStream.Position := 0;
      LMemStream.Read(LDstIntArray, LMemStream.Size);

      // 取得したデータを表示
      for LRow := 0 to FRowCount - 1 do begin
        LResText := '';
        for LCol := 0 to FColCount - 1 do begin
          LResText := LResText + FormatFloat('   0000', LDstIntArray[LRow][LCol]);
        end;
        Memo1.Lines.Add(LResText);
      end;
    end;
  finally
    FreeAndNil(LMemStream);
  end;
end;

implementation

uses
  plCommMem,
  System.Types;

{$R *.dfm}

const
  MAPNAME = 'TEST_1dimDynArray-Double_MEMORY_MAPPED_FILE_NAME';
  MAPSISE = 4096 * 10000;

//=============================================================================
//  フォーム生成時の処理
//  共有メモリの生成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // 十分なサイズの共有メモリを確保
  TplCommMem.Create(MAPSISE, MAPNAME);

  Memo1.ScrollBars := ssVertical;
  Memo1.Font.Size  := 11;
  Memo1.Font.Name  := 'Courier New';
end;

//=============================================================================
//  フォーム破棄の処理
//  共有メモリの解放
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  TplCommMem.Free(MAPNAME);
end;

//=============================================================================
//  共有メモリにテータを書き込む
//  TDoubleDynArray の使用には uses に System.Types が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcDblArray : TDoubleDynArray;
  LCol         : Integer;
  LInfoArray   : TCommMemHeaderArray;
  LMemStream   : TMemoryStream;
begin
  // 配列の要素数を設定して，テスト用のデータを配列要素に代入
  SetLength(LSrcDblArray, 5);
  for LCol := 0 to Length(LSrcDblArray) - 1 do begin
    LSrcDblArray[LCol] := 100 + (LCol + 1) / 10.0;
  end;

  // 共有メモリのヘッダ部を初期化
  WriteCommMemHeader(MAPNAME, LInfoArray, 1);


  LMemStream := TMemoryStream.Create;
  try
    // メモリストリームに配列データを格納
    // 動的配列はポインタなので最初の要素のアドレスを指定する
    LMemStream.Size := Length(LSrcDblArray) * SizeOf(Double);
    LMemStream.Write(@LSrcDblArray[0], LMemStream.Size);

    // 配列データを格納したメモリストリームを共有メモリに書き込む
    WriteCommMemData(MAPNAME, LMemStream, LInfoArray, '1dimDynArray-Double');
  finally
    FreeAndNil(LMemStream);
  end;
end;

//=============================================================================
//  共有メモリからデータを取得する
//  TDoubleDynArray の使用には uses に System.Types が必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LDataCount   : Cardinal;
  LInfoArray   : TCommMemHeaderArray;
  LMemStream   : TMemoryStream;
  LDataType    : string;
  LDstDblArray : TDoubleDynArray;
  LColCount    : Integer;
  LCol         : Integer;
  LResText     : string;
begin
  Memo1.Lines.Clear;

  // 共有メモリのヘッダ部を取得
  if not ReadCommMemHeader(MAPNAME, LInfoArray, LDataCount) then Exit;
  if (LDataCount = 0) then Exit;


  LMemStream := TMemoryStream.Create;
  try
    // 共有メモリのデータをメモリストリームに読み出す
    ReadCommMemData(MAPNAME, LMemStream, LInfoArray, 0, LDataType);

    if LDataType = '1dimDynArray-Double' then begin
      // 配列の要素数を計算
      LColCount := LMemStream.Size div SizeOf(Double);
      // 配列の要素数を設定 (配列用のメモリの確保)
      SetLength(LDstDblArray, LColCount);
      // メモリストリームのデータを配列要素に読み込む
      // 動的配列はポインタなので最初の要素の値を指定する
      LMemStream.Position := 0;
      LMemStream.Read(LDstDblArray[0], LMemStream.Size);

      // 取得したデータを表示
      LResText := '';
      for LCol := 0 to LColCount - 1 do begin
        LResText := LResText + FormatFloat('   000.0', LDstDblArray[LCol]);
      end;
      Memo1.Lines.Add(LResText);
    end;
  finally
    FreeAndNil(LMemStream);
  end;
end;

implementation

uses
  plCommMem;

{$R *.dfm}

const
  MAPNAME = 'TEST_2dimDynArray-integer_MEMORY_MAPPED_FILE_NAME';
  MAPSISE = 4096 * 10000;

type
  TInteger2dimDynArray = array of array of Integer;


//=============================================================================
//  フォーム生成時の処理
//  共有メモリの生成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // 十分なサイズの共有メモリを確保
  TplCommMem.Create(MAPSISE, MAPNAME);

  Memo1.ScrollBars := ssVertical;
  Memo1.Font.Size  := 11;
  Memo1.Font.Name  := 'Courier New';
end;

//=============================================================================
//  フォーム破棄の処理
//  共有メモリの解放
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  TplCommMem.Free(MAPNAME);
end;

//=============================================================================
//  共有メモリにテータを書き込む
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
const
  LRowCount : Integer = 2;
  LColCount : Integer = 5;
var
  LSrcIntArray : TInteger2dimDynArray;
  LRow         : Integer;
  LCol         : Integer;
  LInfoArray   : TCommMemHeaderArray;
  LMemStream   : TMemoryStream;
begin
  // 配列の要素数を設定して，テスト用のデータを配列要素に代入
  SetLength(LSrcIntArray, LRowCount, LColCount);
  for LRow := 0 to LRowCount - 1 do begin
    for LCol := 0 to LColCount - 1 do begin
      LSrcIntArray[LRow][LCol] := (LRow + 1) * 1000 + (LCol + 1);
    end;
  end;

  // 共有メモリのヘッダ部を初期化
  WriteCommMemHeader(MAPNAME, LInfoArray, 1);


  LMemStream := TMemoryStream.Create;
  try
    // メモリストリームに行数と列数の値を格納
    LMemStream.WriteData(LRowCount);
    LMemStream.WriteData(LColCount);

    // メモリストリームに配列データを格納
    // 動的配列の各行はポインタなので各行の最初の要素のアドレスを指定する
    for LRow := 0 to LRowCount - 1 do begin
      LMemStream.Write(@LSrcIntArray[LRow][0], LColCount * SizeOf(Integer));
    end;

    // 配列の行数と列数と要素のデータを格納したメモリストリームを共有メモリに書き込む
    WriteCommMemData(MAPNAME, LMemStream, LInfoArray, '2dimDynArray-integer');
  finally
    FreeAndNil(LMemStream);
  end;
end;

//=============================================================================
//  共有メモリからデータを取得する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LDataCount   : Cardinal;
  LInfoArray   : TCommMemHeaderArray;
  LMemStream   : TMemoryStream;
  LDataType    : string;
  LDstIntArray : TInteger2dimDynArray;
  LRowCount    : Integer;
  LColCount    : Integer;
  LRow         : Integer;
  LCol         : Integer;
  LResText     : string;
begin
  Memo1.Lines.Clear;

  // 共有メモリのヘッダ部を取得
  if not ReadCommMemHeader(MAPNAME, LInfoArray, LDataCount) then Exit;
  if (LDataCount = 0) then Exit;


  LMemStream := TMemoryStream.Create;
  try
    // 共有メモリのデータをメモリストリームに読み出す
    ReadCommMemData(MAPNAME, LMemStream, LInfoArray, 0, LDataType);

    if LDataType = '2dimDynArray-integer' then begin
      LMemStream.Position := 0;
      // 配列の行数と列数の値をメモリストリームから読み出す
      LMemStream.ReadData(LRowCount);
      LMemStream.ReadData(LColCount);  
      // 配列の行数と列数を設定 (配列用のメモリの確保)
      SetLength(LDstIntArray, LRowCount, LColCount);

      // メモリストリームのデータを配列要素に読み込む
      // 動的配列の各行はポインタなので，各行の先頭要素を指定して行単位で読み込む
      for LRow := 0 to LRowCount - 1 do begin
        LMemStream.Read(LDstIntArray[LRow][0], LColCount * SizeOf(Integer));
      end;

      // 取得したデータを表示
      for LRow := 0 to LRowCount - 1 do begin
        LResText := '';
        for LCol := 0 to LColCount - 1 do begin
          LResText := LResText + FormatFloat('   0000', LDstIntArray[LRow][LCol]);
        end;
        Memo1.Lines.Add(LResText);
      end;
    end;
  finally
    FreeAndNil(LMemStream);
  end;
end;

implementation

uses
  plCommMem;

{$R *.dfm}

const
  MAPNAME = '2DIM-DYNARRAY-INTEGER_MEMORY_MAPPED_FILE_NAME';
  MAPSISE = 4096 * 10000;

type
  TInteger2dimDynArray = array of array of Integer;

  TDynArrayHeader = record
    RowCount : Integer;
    ColCount : Integer;
  end;


//=============================================================================
//  フォーム生成時の処理
//  共有メモリの生成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // 十分なサイズの共有メモリを確保
  TplCommMem.Create(MAPSISE, MAPNAME);

  Memo1.ScrollBars := ssVertical;
  Memo1.Font.Size  := 11;
  Memo1.Font.Name  := 'Courier New';
end;

//=============================================================================
//  フォーム破棄の処理
//  共有メモリの解放
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  TplCommMem.Free(MAPNAME);
end;

//=============================================================================
//  共有メモリに 2 次元の動的配列型のデータを書き込む
//  TplCommMem の機能だけを使用する例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
const
  LRowCount : Integer = 2;
  LColCount : Integer = 5;
var
  LSrcIntArray : TInteger2dimDynArray;
  LHeaderInfo  : TDynArrayHeader;
  LOffset      : Cardinal;
  LRowSize     : Cardinal;
  LRow         : Integer;
  LCol         : Integer;
begin
  SetLength(LSrcIntArray, LRowCount, LColCount);
  for LRow := 0 to LRowCount - 1 do begin
    for LCol := 0 to LColCount - 1 do begin
      LSrcIntArray[LRow][LCol] := (LRow + 1) * 1000 + (LCol + 1);
    end;
  end;

  LHeaderInfo.RowCount := LRowCount;
  LHeaderInfo.ColCount := LColCount;
  TplCommMem.Write(MAPNAME, @LHeaderInfo, 0, SizeOf(LHeaderInfo));

  LRowSize := LColCount * SizeOf(Integer);
  for LRow := 0 to LRowCount - 1 do begin
    LOffset := SizeOf(LHeaderInfo) + LRow * LRowSize;
    TplCommMem.Write(MAPNAME, @LSrcIntArray[LRow][0], LOffset, LRowSize);
  end;
end;

//=============================================================================
//  共有メモリから 2 次元の動的配列型のデータを読み出す
//  TplCommMem の機能だけを使用する例
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LDstIntArray : TInteger2dimDynArray;
  LHeaderInfo  : TDynArrayHeader;
  LOffset      : Cardinal;
  LRowSize     : Cardinal;
  LRow         : Integer;
  LCol         : Integer;
  LResText     : string;
begin
  Memo1.Lines.Clear;

  TplCommMem.Read(MAPNAME, @LHeaderInfo, 0, SizeOf(LHeaderInfo));

  SetLength(LDstIntArray, LHeaderInfo.RowCount, LHeaderInfo.ColCount);

  LRowSize := LHeaderInfo.ColCount * SizeOf(Integer);
  for LRow := 0 to LHeaderInfo.RowCount - 1 do begin
    LOffset := SizeOf(LHeaderInfo) + LRow * LRowSize;
    TplCommMem.Read(MAPNAME, @LDstIntArray[LRow][0], LOffset, LRowSize);
  end;

  for LRow := 0 to LHeaderInfo.RowCount - 1 do begin
    LResText := '';
    for LCol := 0 to LHeaderInfo.ColCount - 1 do begin
      LResText := LResText + FormatFloat('   0000', LDstIntArray[LRow][LCol]);
    end;
    Memo1.Lines.Add(LResText);
  end;
end;

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  ポインタは,指し示すという意味．つまりポインタは文字通りポインタである
//  ポインタが指し示すのはメモリアドレス (の値)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LPointer : Pointer;
  LAddress : NativeUInt;
  LText    : string;
begin
  // Delphi のクラス型の変数はポインタ
  // したがって Pointer 型の変数に代入できる
  // ただし,TButton 型であるという情報は失われる
  LPointer := Button1;

  // ポインタはオブジェクトのデータの場所を示すポインタとなっている
  // その実体はメモリアドレス (メモリの番地)
  // NativeUInt でキャストすればそのメモリアドレスが取得できる 
  LAddress := NativeUInt(LPointer);

  // そのアドレスに格納されているオブジェクトの型でキャストすればアクセスできる
  TButton(LAddress).Caption := 'ボタン';

  // 上の操作で Button1 の Caption の値が変わっているのが確認できる
  LText := '$' + IntToHex(LAddress, 8) + sLineBreak + Button1.Caption;
  MessageBox(Handle, PChar(LText), '情報', MB_ICONINFORMATION);
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plCommMem;

{$R *.dfm}

const
  MAPNAME = 'POINTER_MEMORY_MAPPED_FILE_NAME';

//=============================================================================
//  フォーム生成時の処理
//  共有メモリの生成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  TplCommMem.Create(4096, MAPNAME);

  Button1.Caption := '書き込み';
  Button2.Caption := '読み出し';
end;

//=============================================================================
//  共有メモリを使用しなくなったら必ずの解放破棄する
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  TplCommMem.Free(MAPNAME);
end;

//=============================================================================
//  共有メモリにテータを書き込む
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  // Button1 のアドレスを共有メモリに書き込む
  // SizeOf(Button1) は SizeOf(TButton) と同じ
  // Button1 はポインタなので,この値は 32 ビットの EXE では 4 バイト
  TplCommMem.Write(MAPNAME, @Button1, 0, SizeOf(Button1));
end;

//=============================================================================
//  共有メモリからデータを取得する
//  共有メモリに限らず,メモリ上のデータは単なるバイトデータ
//  そのバイトデータを特定のオブジェクトのデータとして操作することで意味を持つ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LPointer : Pointer;
begin
  // 共有メモリからポインタを取り出す
  // これは他のプロセスからも取得できる
  TplCommMem.Read(MAPNAME, @LPointer, 0, SizeOf(LPointer));

  // 以下は,同じプロセス内で実行すればエラーにならない
  // 他のプロセスから実行すると例外が発生する
  // LPointer が示すアドレスには,他のプロセスからはアクセスできない
  TButton(LPointer).Caption := 'ボタン';
end;

end.

unit plCommMem;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Dialogs;

type
  // データ数もレコード型にしておく 
  TCommMemFileHeader = record
    Count : Integer;  // データ数
  end;

  TCommMemHeader = record
    Offset : Cardinal;              // 書き込んだ位置（先頭からのオフセットバイト）
    Size : Cardinal;                // データのバイト数
    dType : array[0..32] of Char;   // データの形式 (種類)．格納内容は任意
  end;
  PCommMemHeader = ^TCommMemHeader;

  // 上のレコード型の動的配列
  TCommMemHeaderArray = array of TCommMemHeader;
  PCommMemHeaderArray = ^TCommMemHeaderArray;

  PplCommMem = ^TplCommMem;
  TplCommMem = record
  private
    class var
      FhCommMem : THandle;
    class procedure Open(var hMutex: THandle; var hMapObject: THandle;
      var pBaseAddr: Pointer; MapFileName: string); static;
    class procedure Close(hMutex: THandle; hObject: THandle; pBaseAddr: Pointer); static;
  public
    class procedure Create(AllocSize: DWORD; MapFileName: string); static;
    class procedure Free(MapFileName: string); static;
    class function Write(MapFileName: string; Source: Pointer; Offset: DWORD;
      Length: DWORD): Boolean; static;
    class function Read(MapFileName: string; Destination: Pointer; Offset: DWORD;
      Length: DWORD): Boolean; static;
    class function Size(MapFileName: string): NativeUInt; static;
  end;

  // 以下は共有メモリで複数のデータを扱う場合の関数類
  // これらの関数類は TplCommMem では使用していない 
  function WriteCommMemHeader(AMapName: string; var AInfoArray: TCommMemHeaderArray;
    ADataCount: Cardinal): Boolean;
  function WriteCommMemData(AMapName: string; ASrcStream: TMemoryStream;
    var AInfoArray: TCommMemHeaderArray; ADataType: string): Boolean;
  function ReadCommMemHeader(AMapName: string; var AInfoArray: TCommMemHeaderArray;
    var ADataCount: Cardinal): Boolean;
  function ReadCommMemData(AMapName: string; ADstStream: TMemoryStream;
    AInfoArray: TCommMemHeaderArray; AIndex: Integer; var ADataType: string):
    Boolean;
  function StringToMemStream(AText: string; ADstStream: TMemoryStream): Boolean;
  function MemStreamToString(ASrcStream: TMemoryStream): string;

implementation

var
  FErrorText : string;
const
  // 追加した関数類で使用する定数値
  // この値も上の TCommMemXXX レコード型も TplCommMem では使用していない
  FFileHeaderSize : Cardinal = SizeOf(TCommMemFileHeader);
  FInfoHeaderSize : Cardinal = SizeOf(TCommMemHeader);

{ TplCommMem }

//=============================================================================
//  名前付きメモリマップドファイルを使用した共有メモリの作成
//
//  AllocSize   : 確保する共有メモリ (メモリマップドファイル) のサイズ (バイト)
//  MapFileName : 共有メモリ名 (メモリマップドファイル名)
//
//  引数の MapFileName のメモリマップドファイルが存在する場合，新規作成はしない
//  この場合，エラー値は ERROR_ALREADY_EXISTS となる
//
//  メモリマップドファイルのサイズは，ページサイズ (4 KB) 単位で指定する
//  ページサイズの倍数値でない場合は自動調整される
//=============================================================================
class procedure TplCommMem.Create(AllocSize: DWORD; MapFileName: string);
begin
  FhCommMem:= CreateFileMapping(INVALID_HANDLE_VALUE,
                                nil,
                                PAGE_READWRITE,
                                0,
                                AllocSize,
                                PChar(MapFileName));
end;

//=============================================================================
//  共有メモリ破棄
//  共有メモリのメモリマップドファイルの破棄は，作成したアプリでないとできない
//=============================================================================
class procedure TplCommMem.Free(MapFileName: string);
var
  LhMapObj : THandle;
begin
  LhMapObj:= OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MapFileName));
  if LhMapObj <> 0 then begin
    CloseHandle(LhMapObj);
    CloseHandle(FhCommMem);
    FhCommMem := 0;
  end;
end;

//=============================================================================
//  共有メモリにデータを書き込む
//
//  MapFileName : メモリマップドファイルの名前 ( 共有メモリの名前 )
//  Source      : 共有メモリに書き込むデータのアドレス
//  Offset      : データを書き込み開始する共有メモリの先頭からの位置 (バイト単位)
//  Length      : 共有メモリに書き込むデータのバイトサイズ  
//=============================================================================
class function TplCommMem.Write(MapFileName: string; Source: Pointer;
  Offset: DWORD; Length: DWORD): Boolean;
var
  LhMutex     : THandle;
  LhMapObj    : THandle;
  LpBaseAddr  : Pointer;
  LMemoryInfo : MEMORY_BASIC_INFORMATION;
begin
  Result := False;

  Open(LhMutex, LhMapObj, LpBaseAddr, MapFileName);
  if LhMapObj <> 0 then begin
    VirtualQuery(LpBaseAddr, LMemoryInfo, SizeOf(LMemoryInfo));
    if (Offset + Length) < LMemoryInfo.RegionSize then begin
     // ミューテックスオブジェクトの状態をチェック
     // 処理中の時は待つ
      WaitForSingleObject(LhMutex, INFINITE);
      // データを書き込む
      CopyMemory(Pointer(NativeUInt(LpBaseAddr) + Offset), Source, Length);
      // フラッシュして確実に更新する
      FlushViewOfFile(Pointer(NativeUInt(LpBaseAddr) + Offset), Length);
      Result := True;
    end else begin
      // 書き込みサイズオーバー
    end;
  end;
  Close(LhMutex, LhMapObj, LpBaseAddr);
end;

//=============================================================================
//  共有メモリからデータを読み出す
//
//  MapFileName : メモリマップドファイルの名前 ( 共有メモリの名前 )
//  Destination : 共有メモリから読み込んだデータの格納アドレス
//  Offset      : データを読み出す共有メモリの先頭からの位置 (バイト単位)
//  Length      : 共有メモリから読み込むデータのバイトサイズ
//=============================================================================
class function TplCommMem.Read(MapFileName: string; Destination: Pointer;
  Offset: DWORD; Length: DWORD): Boolean;
var
  LhMutex     : THandle;
  LhMapObj    : THandle;
  LpBaseAddr  : Pointer;
  LMemoryInfo : MEMORY_BASIC_INFORMATION;
begin
  Result := False;

  Open(LhMutex, LhMapObj, LpBaseAddr, MapFileName);
  if LhMapObj <> 0 then begin
    VirtualQuery(LpBaseAddr, LMemoryInfo, SizeOf(LMemoryInfo));
    if (Offset + Length) < LMemoryInfo.RegionSize then begin
     // ミューテックスオブジェクトの状態をチェック
     // 処理中の時は待つ
      WaitForSingleObject(LhMutex, INFINITE);
      // データを読み出す
      CopyMemory(Destination, Pointer(NativeUInt(LpBaseAddr) + Offset), Length);
      Result := True;
    end else begin
      // 読み出しサイズオーバー
    end;
  end else begin
    ZeroMemory(Destination, Length);
  end;
  Close(LhMutex, LhMapObj, LpBaseAddr);
end;

//=============================================================================
//  共有メモリ (メモリマッブドファイル) のバイトサイトを取得
//=============================================================================
class function TplCommMem.Size(MapFileName: string): NativeUInt;
var
  LhMutex     : THandle;
  LhMapObj    : THandle;
  LpBaseAddr  : Pointer;
  LMemoryInfo : MEMORY_BASIC_INFORMATION;
begin
  Result := 0;

  Open(LhMutex, LhMapObj, LpBaseAddr, MapFileName);
  if LhMapObj <> 0 then begin
    VirtualQuery(LpBaseAddr, LMemoryInfo, SizeOf(LMemoryInfo));
    Result := LMemoryInfo.RegionSize;
  end;
  Close(LhMutex, LhMapObj, LpBaseAddr);
end;

//=============================================================================
//  ミューテックスオブジェクトを生成
//  メモリマッブドファイルを開く
//=============================================================================
class procedure TplCommMem.Open(var hMutex: THandle; var hMapObject: THandle;
  var pBaseAddr: Pointer; MapFileName: string);
var
  LMutexName : string;
begin
  hMapObject := 0;
  // ミューテックスオブジェクトを生成
  LMutexName := MapFileName + '_Mutex';
  hMutex := CreateMutex(nil, False, PChar(LMutexName));
  if hMutex = 0 then Exit;

  // メモリマッブドファイルのハンドルを取得
  hMapObject := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MapFileName));
  if hMapObject <> 0 then begin
    // 共有メモリの先頭アドレスのポインタを取得
    pBaseAddr := MapViewOfFile(hMapObject, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  end;
end;

//=============================================================================
//  メモリマッブドファイルを閉じる
//  ミューテックスオブジェクトの所有権の破棄とハンドルの開放
//=============================================================================
class procedure TplCommMem.Close(hMutex: THandle; hObject: THandle; pBaseAddr: Pointer);
begin
  if hObject <> 0 then begin
   UnmapViewOfFile(pBaseAddr);
    CloseHandle(hObject);
  end;

  // ミューテックスオブジェクトの所有権の破棄とハンドルの開放
  if hMutex <> 0 then begin
    ReleaseMutex(hMutex);
    CloseHandle(hMutex);
  end;
end;

//-----------------------------------------------------------------------------
//  データの情報を取得してレコード型のメンバの値を調べる
//  WriteCommMemHeader が実行されていれば初期化さて 0 になっている
//-----------------------------------------------------------------------------
function CheckInfoHeader(AMapName: string; AIndex: Integer): Boolean;
var
  LInfoHeader : TCommMemHeader;
  LInfoOffset : Cardinal;
begin
  // データ情報を格納しているのレコード型の値を読み出す
  LInfoOffset := FFileHeaderSize + Cardinal(AIndex) * FInfoHeaderSize;
  TplCommMem.Read(AMapName,
                 @LInfoHeader,
                 LInfoOffset,
                 FInfoHeaderSize);
  Result := (LInfoHeader.Offset > 0) and (LInfoHeader.Offset > 0);
end;

//-----------------------------------------------------------------------------
//  TplCommMem を利用して複数データを共有メモリに書き込むための関数
//  共有メモリのヘッダ部の初期処理
//  WriteCommMemDat 関数でデータを書き込む前にこの関数を実行する
//
//  AMapName        : 共有メモリ名
//  var AInfoArray  : データの情報を格納する TCommMemHeader;レコード型の動的配列
//  ADataCount      : 配列の要素数．この値がデータ数
//-----------------------------------------------------------------------------
function WriteCommMemHeader(AMapName: string; var AInfoArray: TCommMemHeaderArray;
  ADataCount: Cardinal): Boolean;
var
  LFileHeader : TCommMemFileHeader;
  LMemStream  : TMemoryStream;
  LMemSize    : Cardinal;
begin
  Result := False;

  if (ADataCount <= 0) then begin
    FErrorText := '配列の要素数は 1 以上必要です．';
    MessageBox(0, PChar(FErrorText), '情報', MB_ICONWARNING);
    Exit;
  end;

  // 配列の要素数を設定
  SetLength(AInfoArray, ADataCount);

  // ヘッダ部の利用域を初期化
  LMemStream := TMemoryStream.Create;
  try
    LMemSize := FFileHeaderSize + Cardinal(Length(AInfoArray)) * FInfoHeaderSize;
    if (LMemSize > TplCommMem.Size(AMapName)) then begin
      FErrorText := '書き込むサイズが共有メモリのサイズを越えています．';
      MessageBox(0, PChar(FErrorText), '情報', MB_ICONWARNING);
      Exit;
    end;

    LMemStream.Size := LMemSize;
    ZeroMemory(LMemStream.Memory, LMemSize);
    Result := Tplcommmem.Write(AMapName, LMemStream.Memory, 0, LMemSize);
  finally
    FreeAndNil(LMemStream);
  end;
  if not Result then begin
    FErrorText := '共有メモリにアクセスできません．' + sLineBreak
                +  '指定名の共有メモリが作成されていない可能性があります．';
    MessageBox(0, PChar(FErrorText), '情報', MB_ICONWARNING);
    Exit;
  end;

  // 共有メモリの先頭にデータ数をレコード型として書き込む
  LFileHeader.Count := ADataCount;
  Result := TplCommMem.Write(AMapName, @LFileHeader, 0, FFileHeaderSize);
end;

//-----------------------------------------------------------------------------
//  TplCommMem を利用して複数データを共有メモリに書き込むための関数
//  データを書き込む関数
//  実際に書き込むのは引数の TMemoryStream のデータ 
//  書き込むデータは TMemoryStream に格納する必要がある
//
//  AMapName        : 共有メモリ名
//  ASrcStream      : 共有メモリに書き込むデータが格納されているメモリストリーム
//  var AInfoArray  : データの情報を格納する TCommMemHeader;レコード型の動的配列
//                    このメンバに値をセットして共有メモリにデータを書き込む
//  ADataType       : データの形式．内容は任意
//
//  共有メモリのヘッダ部のすぐ後にデータを書き込む
//  この関数を実行する度に順番にシーケンシャルにデータを書き込んでいく
//-----------------------------------------------------------------------------
function WriteCommMemData(AMapName: string; ASrcStream: TMemoryStream;
  var AInfoArray: TCommMemHeaderArray; ADataType: string): Boolean;
{$WRITEABLECONST ON}
const
  LIndex      : Integer = 0;
  LDataCount  : Integer = 0;
  LDataOffset : Cardinal = 0;
{$WRITEABLECONST OFF}
var
  LInfoOffset : Cardinal;
begin
  Result := False;

  if Length(AInfoArray) <= 0 then begin
    FErrorText := '配列の要素数が設定されていません．';
    MessageBox(0, PChar(FErrorText), '情報', MB_ICONWARNING);
    Exit;
  end;

  // 最初のデータ情報を格納しているのレコード型の値をチェック
  if not CheckInfoHeader(AMapName, 0) then LIndex := 0;
  if LIndex = 0 then begin
    // 最初のデータの書き込みの時の処理
    // ヘッダ部からデータ数を読み出す
    Result := TplcommMem.Read(AMapName, @LDataCount, 0, FFileHeaderSize);
    // 最初のデータを書き込む共有メモリ上の位置
    LDataOffset := FFileHeaderSize + cardinal(LDataCount) * FInfoHeaderSize;
  end;
  // テータの情報を格納するレコード型のデータの書き込み位置
  LInfoOffset := FFileHeaderSize + Cardinal(LIndex) * FInfoHeaderSize;

  if LDataCount <> Length(AInfoArray) then begin
    FErrorText := 'データ数は途中変更できません．';
    MessageBox(0, PChar(FErrorText), '情報', MB_ICONWARNING);
    Exit;
  end;
  if LIndex > High(AInfoArray) then begin
    FErrorText := '書き込むデータ数が配列の要素数を超えています．';
    MessageBox(0, PChar(FErrorText), '情報', MB_ICONWARNING);
    Exit;
  end;
  if ((LInfoOffset + FInfoHeaderSize) > TplCommMem.Size(AMapName))
      or ((LDataOffset + ASrcStream.Size) > TplCommMem.Size(AMapName)) then begin
    FErrorText := '書き込むサイズが共有メモリのサイズを越えています．';
    MessageBox(0, PChar(FErrorText), '情報', MB_ICONWARNING);
    Exit;
  end;

  // テータの情報を各メンバに設定してレコード型のデータを書き込む
  AInfoArray[LIndex].Offset := LDataOffset;
  AInfoArray[LIndex].Size   := ASrcStream.Size;
  // 静的文字配列の要素を全て Null 文字にして String 型の文字列を代入
  FillChar(AInfoArray[LIndex].dType[0], SizeOF(AInfoArray[LIndex].dType), #0);
  StrPCopy(AInfoArray[LIndex].dType, ADataType);
  Result := TplCommMem.Write(AMapName,
                             @AInfoArray[LIndex],
                             LInfoOffset,
                             FInfoHeaderSize);
  if Result then begin
    // TMemoryStream のデータを共有メモリに書き込む
    Result := TplCommMem.Write(AMapName,
                               ASrcStream.Memory,
                               LDataOffset,
                               ASrcStream.Size);
    if Result then begin
      // 次のデータの書き込み位置
      LDataOffset := LDataOffset + ASrcStream.Size;
      // 次の動的配列の要素番号
      LIndex := LIndex + 1;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  共有メモリからヘッダ部のデータを取得する関数
//  ヘッダ部には共有メモリに書き込んだデータ数
//  各データの情報を格納したレコード型のデータがデータ数分ある
//  実際のデータはこのヘッダ部の後に書き込まれている
//
//  AMapName      　: 共有メモリ名
//  var AInfoArray : データの情報を格納した TCommMemHeader;レコード型の動的配列
//                   この関数はこのデータと次の引数の値を取得する
//  ar ADataCount　: データ数
//-----------------------------------------------------------------------------
function ReadCommMemHeader(AMapName: string; var AInfoArray: TCommMemHeaderArray;
  var ADataCount: Cardinal): Boolean;
var
  LFileHeader : TCommMemFileHeader;
  LInfoSize   : Integer;
begin
  ADataCount := 0;

  // 共有メモリの先頭からデータ数の値をレコード型として読み出す
  Result := TplCommMem.Read(AMapName, @LFileHeader, 0, FFileHeaderSize);

  if not Result then begin
    FErrorText := '共有メモリにアクセスできません．' + sLineBreak
                +  '指定名の共有メモリが作成されていない可能性があります．';
    MessageBox(0, PChar(FErrorText), '情報', MB_ICONWARNING);
    Exit;
  end;

  ADataCount := LFileHeader.Count;
  // 動的配列の要素数を設定
  SetLength(AInfoArray, ADataCount);

  // データの情報を格納しているレコード型のデータを全て読み込む
  // LInfoSize はテータの情報を格納しているレコード型の全バイト数
  // 動的配列は，1 次元であれば最初の要素のアドレス指定で読み込める
  // 動的配列の最初の要素番号は常に 0
  LInfoSize := ADataCount * FInfoHeaderSize;
  Result := TplCommMem.Read(AMapName, @AInfoArray[0], FFileHeaderSize, LInfoSize);

  // 最初のデータ情報を格納しているのレコード型の値をチェック
  if not CheckInfoHeader(AMapName, 0) then begin
    FErrorText := 'ヘッダ部に情報がありません．';
    MessageBox(0, PChar(FErrorText), '情報', MB_ICONWARNING);
    Exit;
  end;
end;

//-----------------------------------------------------------------------------
//   TplCommMem を利用して複数データを書き込んだ共有メモリからデータを読み込む関数
//  実際には引数の TMemoryStream に読み込む 
//
//  AMapName      　: 共有メモリ名
//  ADstStream    　: このメモリストリームに共有メモリから読み出したデータを格納
//  var AInfoArray : データの情報を格納した TCommMemHeader;レコード型の動的配列
//                   この関数実行前に ReadCommMemHeader 関数を実行すると取得できる
//  AIndex        : データの情報を格納した TCommMemHeader レコード型の動的配列の要素番号
//                  この要素番号のデータを引数の TMemoryStream に格納する
//  var ADataType : 読み出したデータの形式
//-----------------------------------------------------------------------------
function ReadCommMemData(AMapName: string; ADstStream: TMemoryStream;
  AInfoArray: TCommMemHeaderArray; AIndex: Integer; var ADataType: string): Boolean;
begin
  Result := False;

  if (AIndex < 0) or (AIndex > High(AInfoArray)) then begin
    FErrorText := '配列の要素番号が範囲外です．';
    MessageBox(0, PChar(FErrorText), '情報', MB_ICONWARNING);
    Exit;
  end;

  if not CheckInfoHeader(AMapName, AIndex) then begin
    FErrorText := '要素 ' + IntToStr(AIndex)
                + ' (  ' + IntToStr(AIndex + 1) + ' 番目 ) のデータがありません．';
    MessageBox(0, PChar(FErrorText), '情報', MB_ICONWARNING);
    Exit;
  end;

  ADataType :=  AInfoArray[AIndex].dType;
  ADstStream.Size := AInfoArray[AIndex].Size;
  Result := TplCommMem.Read(AMapName,
                            ADstStream.Memory,
                            AInfoArray[AIndex].Offset,
                            AInfoArray[AIndex].Size);
  ADstStream.Position := 0;
end;

//-----------------------------------------------------------------------------
//  String 型の文字列をメモリストリームに格納する関数
//
//  原則として
//  Create 等で生成するオブジェクトは関数の戻り値にはしない
//  クラス型のインスタンスを手続きや関数内で生成して引数や戻り値にはしない
//-----------------------------------------------------------------------------
function StringToMemStream(AText: string; ADstStream: TMemoryStream): Boolean;
begin
  ADstStream.Size := Length(AText) * SizeOf(Char);
  if ADstStream.Size > 0 then begin
    Move(AText[1], ADstStream.Memory^, ADstStream.Size);
  end;
  Result := ADstStream.Size > 0;
end;

//-----------------------------------------------------------------------------
//  メモリストリームのデータを String 型の文字列変数に代入する関数
//-----------------------------------------------------------------------------
function MemStreamToString(ASrcStream: TMemoryStream): string;
begin
  Result := '';
  if ASrcStream.Size = 0 then Exit;

  SetLength(Result, ASrcStream.Size div SizeOf(Char));
  Move(ASrcStream.Memory^, Result[1], ASrcStream.Size);
end;

end.