Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2025年04月21日] [更新 2025年04月22日]　Delphi 一般・その他
テキストと画像を 1 つのファイルとして保存
動作確認等 Windows 10 ビルド 19045 Pro 64 bit + Delphi XE5(UP2) Pro VCL-32
[整理番号 - 1240]






テキストと画像を 1 つのファイルとして保存


画像を，テキストと共に 1 つのファイルにして保存するサンプルです．
多くの画像を管理するにはデータベースにしてしまう方が便利ですが，説明テキストと一緒に画像を保存すると便利なことがあるかも知れません．本ページのサンプルでは，テキストは，文字数を意識しなてもいいように TStrings 型の変数で扱い，Unicode (UTF-16) で保存するようにしています．





01_テキストと TBitmap 画像を 1 つのファイルにして保存


TBitmap の画像ファイルとテキストを 1 つのファイルに保存する例です．


図1
[新規画像] をクリック
  • TBitmap の画像ファイルを読み込んで TImage に描画
  • 右の TMemo に保存するテキストを入力する

図2
[保存・クリア] をクリック
  • コンテナコントロール上に配置している 描画用コントロールの保存となる
図3
[読み込み] をクリック
  • 保存した画像とテキストを表示

リスト1 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    Memo1: TMemo;
    Button3: TButton;
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    FBitmap : TBitmap;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(FBitmap) then FreeAndNil(FBitmap);
end;

//=============================================================================
//  新規画像
//  FBitmap は現在操作中の TBitmap のインスタンス名
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if Assigned(FBitmap) then FreeAndNil(FBitmap);
  Image1.Picture.Assign(nil);
  Memo1.Lines.Clear;

  FBitmap := TBitmap.Create;

  // 画像を読み込んで TImage に描画
  FBitmap.LoadFromFile('bug.bmp');
  FBitmap.AlphaFormat := afDefined;
  Image1.Stretch := True;
  Image1.Picture.Bitmap := FBitmap;

　Memo1.Lines.Text := 'テントウ虫';
end;

//=============================================================================
///  保存・クリア
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LFilePath   : string;
  LFileStream : TFileStream;
  LByteStream : TBytesStream;
  LByteSize   : Integer;
begin
  if not Assigned(FBitmap) then Exit;

  LFilePath := 'aaa.dat';
  DeleteFile(LFilePath);


  LFileStream := TFileStream.Create(LFilePath, fmCreate);
  LByteStream := TBytesStream.Create;
  try
    // 書き込むテキストのサイズ ( バイト数 ) とテキストを書き込む
    LByteStream.Clear;
    Memo1.Lines.SaveToStream(LByteStream, TEncoding.Unicode);
    LByteSize := LByteStream.Size;
    LFileStream.WriteData(LByteSize);
    LFileStream.Write(LByteStream.Bytes[0], LByteSize);

    // TBitmap を書き込む
    FBitmap.SaveToStream(LFileStream);
  finally
    FreeAndNil(LFileStream);
    FreeAndNil(LByteStream);
  end;

  Image1.Picture.Assign(nil);
  Memo1.Lines.Clear;
end;

//=============================================================================
///  読み出し
//
//  TBytesStream に格納されている文字列は，以下のようにしても取得可能
//    var
//      LText : string;
//    LText := TEncoding.Unicode.GetString(LByteStream.Bytes);
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LFilePath   : string;
  LFileStream : TFileStream;
  LByteStream : TBytesStream;
  LByteSize   : Integer;
begin
  LFilePath := 'aaa.dat';
  Image1.Picture.Assign(nil);
  Memo1.Lines.Clear;
  if not FileExists(LFilePath) then Exit;


  if Assigned(FBitmap) then FreeAndNil(FBitmap);

  LFileStream := TFileStream.Create(LFilePath, fmOpenRead);
  LByteStream := TBytesStream.Create;
  FBitmap     := TBitmap.Create;
  try
    // 書き込んだテキストのバイト数ょ読み出してテキストを読み込む
    TFileStream(LFileStream).ReadData(LByteSize);
    LByteStream.Size := LByteSize;
    LFileStream.Read(LByteStream.Bytes[0], LByteSize);
    LByteStream.Position := 0;
    Memo1.Lines.LoadFromStream(LByteStream, TEncoding.Unicode);

    // TBitmap を読み込む
    FBitmap.LoadFromStream(LFileStream);

    // 読み込んだ TBitmap を TImage に描画
    Image1.Stretch := True;
    Image1.Picture.Bitmap := FBitmap;
    Image1.Picture.Bitmap.AlphaFormat := afDefined;
  finally
    FreeAndNil(LFileStream);
    FreeAndNil(LByteStream);
  end;
end;

end.


このサンプルでは TMemo のテキストを保存し，読み出してテキストも TMemo に表示します．
TStringList でテキストを扱う場合は，保存と読み出しのコードを以下のようにします．

 


    TStringList.SaveToStream(LByteStream, TEncoding.Unicode);
    TStringList.LoadFromStream(LByteStream, TEncoding.Unicode);




02_テキストと TGPBitmap 画像を 1 つのファイルにして保存


GDI+ の TGPBitmap の画像とテキストを 1 つのファイルに保存する例です．
上のサンプルは TBitmap 画像専用ですが，GDI+ の TGPBitmap では，数種類の画像ファイルや画像データをメモリストリームから読み込んで，TGPBitmap のインスタンスとして扱えます．汎用的な方法と言えます．TGPBitmap は，画像データを独自の形式で格納します．読み込む画像形式のデータは保持していません．

TGPBitmap そのものを保存したり，メモリストリームに格納することはできません．他の画像形式のデータに変換して保存したりメモリストリームに格納します．本サンプルでは PNG 形式の画像として保存しています．


リスト2 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls,
  StdCtrls, GDIPOBJ, GDIPAPI, GDIPUTIL;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    Memo1: TMemo;
    Button3: TButton;
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    FGPBitmap : TGPBitmap;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const
  ImageBMPClsid  : TGUID = '{557CF400-1A04-11D3-9A73-0000F81EF32E}';
  ImageJPEGClsid : TGUID = '{557CF401-1A04-11D3-9A73-0000F81EF32E}';
  ImageGIFClsid  : TGUID = '{557CF402-1A04-11D3-9A73-0000F81EF32E}';
  ImageTIFFClsid : TGUID = '{557CF405-1A04-11D3-9A73-0000F81EF32E}';
  ImagePNGClsid  : TGUID = '{557CF406-1A04-11D3-9A73-0000F81EF32E}';

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);
end;

//=============================================================================
//  新規画像
//  FGPBitmap は現在操作中の TGPBitmap のインスタンス名
//
//  TGPBitmap.Create の引数には bmp, gif, ico, jpg, tif 等の画像ファイルを指定;
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LGPGraphics : TGPGraphics;
begin
  if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);
  Image1.Picture.Assign(nil);
  Memo1.Lines.Clear;

  try
    // 画像ファイルを読み込んで TImage.Canvas に描画
    FGPBitmap := TGPBitmap.Create('bug.png');
    LGPGraphics := TGPGraphics.Create(Image1.Canvas.Handle);
    LGPGraphics.DrawImage(FGPBitmap, 0, 0, Image1.Width, Image1.Height);

    // 説明テキスト
　  Memo1.Lines.Text := 'テントウ虫';
  finally
    FreeAndNil(LGPGraphics);
  end;
end;

//=============================================================================
///  保存・クリア
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LFilePath   : string;
  LFileStream : TFileStream;
  LByteStream : TBytesStream;
  LByteSize   : Integer;
begin
  if not Assigned(FGPBitmap) then Exit;

  LFilePath := 'aaa.dat';
  DeleteFile(LFilePath);

  LFileStream := TFileStream.Create(LFilePath, fmCreate);
  LByteStream := TBytesStream.Create;
  try
    // 書き込むテキストのサイズ ( バイト数 ) とテキストを書き込む
    LByteStream.Clear;
    Memo1.Lines.SaveToStream(LByteStream, TEncoding.Unicode);
    LByteSize := LByteStream.Size;
    LFileStream.WriteData(LByteSize);
    LFileStream.Write(LByteStream.Bytes[0], LByteSize);

    // TGPBitmap のデータサイズとデータを書き込む
    LByteStream.Clear;
    FGPBitmap.Save(TStreamAdapter.Create(LByteStream), ImagePNGClsid);
    LByteSize := LByteStream.Size;
    LFileStream.WriteData(LByteSize);
    LFileStream.Write(LByteStream.Bytes[0], LByteSize);
  finally
    FreeAndNil(LFileStream);
    FreeAndNil(LByteStream);
  end;

  Image1.Picture.Assign(nil);
  Memo1.Lines.Clear;
end;

//=============================================================================
///  読み出し
//
//  TBytesStream に格納されている文字列は，以下のようにしても取得可能
//    var
//      LText : string;
//    LText := TEncoding.Unicode.GetString(LByteStream.Bytes);
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LFilePath   : string;
  LFileStream : TFileStream;
  LByteStream : TBytesStream;
  LGPGraphics : TGPGraphics;
  LByteSize   : Integer;
begin
  LFilePath := 'aaa.dat';
  Image1.Picture.Assign(nil);
  Memo1.Lines.Clear;
  if not FileExists(LFilePath) then Exit;


  if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);

  LFileStream := TFileStream.Create(LFilePath, fmOpenRead);
  LByteStream := TBytesStream.Create;
  try
    // 書き込んだテキストのバイト数ょ読み出してテキストを読み込む
    TFileStream(LFileStream).ReadData(LByteSize);
    LByteStream.Size := LByteSize;
    LFileStream.Read(LByteStream.Bytes[0], LByteSize);
    LByteStream.Position := 0;
    Memo1.Lines.LoadFromStream(LByteStream, TEncoding.Unicode);

    // TGPBitmap のデータサイズを読み込む
    LFileStream.ReadData(LByteSize);

    // TGPBitmap を読み込む
    LByteStream.Size := LByteSize;
    LFileStream.Read(LByteStream.Bytes[0], LByteSize);
    FGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(LByteStream));

    // 読み込んだ TGPBitmap を TImage に描画
    LGPGraphics := TGPGraphics.Create(Image1.Canvas.Handle);
    LGPGraphics.DrawImage(FGPBitmap, 0, 0, Image1.Width, Image1.Height);
  finally
    FreeAndNil(LFileStream);
    FreeAndNil(LByteStream);
    FreeAndNil(LGPGraphics);
  end;
end;

end.



03_アルファチャンネル付き TBitmap を TGPBitmap に変換


前項のサンプルで，[新規画像] では次のようなコードが画像ファイルを TGPBitmap にしています．下図は，アルファチャンネル付きのビットマップ画像ファイルを読み込んで TImage に描画した結果です．背景の黒は透明色のピクセルです．

 


    // 画像ファイルを読み込んで TImage に描画
    FGPBitmap := TGPBitmap.Create('bug.bmp');


図4
透明色があるのビットマップ画像

また，このサンプルでは PNG 画像として保存していますが，save メソッドで ImageBMPClsid を指定してビットマップとして保存すると，読み込んだ時に透明色は黒になります．

 


    // TGPBitmap のデータサイズとデータを書き込む
    LByteStream.Clear;
    FGPBitmap.Save(TStreamAdapter.Create(LByteStream), ImageBMPClsid);


図5
ビットマップ画像として保存
  • 透明色は黒になる

TGPBitmap は TBitmap ビットマップのアルファ値を処理しません．上の図は，その結果です．


参考リンクの 関数 SetAlphaValueFromTBitmap は，TBitmap から生成した TGPBitmap を使用してアルファ値をセットしています．本ページのような処理では，以下のような関数を作成して利用すると便利です．

 


//-----------------------------------------------------------------------------
//  TBitmap をアルファ値を処理して TGPBitmap に変換
//-----------------------------------------------------------------------------
function BitmapToGPBitmap(SrcBitmap: TBitmap; DstGPBitmap: TGPBitmap): Boolean;
type
  TRGBQArray = array [0..4095] of RGBQUAD;
  PRGBQArray = ^TRGBQArray;
var
  LBmpData    : TBitmapData;
  LScanLine   : PByte;
  LpRGBQuad   : PRGBQuad;
  LWidth      : Integer;
  LHeight     : Integer;
  LDataStride : Integer;
  LXPos       : integer;
  LYPos       : Integer;
  LScanArray  : PRGBQArray;
  LAValue     : Byte;
  LRValue     : Byte;
  LGValue     : Byte;
  LBValue     : Byte;
begin
  Result := False;

  SrcBitmap.PixelFormat := pf32bit;

  LWidth  := SrcBitmap.Width;
  LHeight := SrcBitmap.Height;

  SrcBitmap.Canvas.Lock;
  if DstGPBitmap.LockBits(MakeRect(0, 0, LWidth, LHeight), ImageLockModeWrite,
                                   PixelFormat32bppARGB, LBmpData) <> Ok then exit;

  LScanLine   := LBmpData.Scan0;
  LDataStride := LBmpData.Stride;

  for LYPos := 0 to LHeight - 1 do begin
    LpRGBQuad  := PRGBQuad(LScanLine);
    LScanArray := SrcBitmap.ScanLine[LYPos];

    for LXPos := 0 to LWidth - 1 do begin

      LAValue := LScanArray[LXPos].rgbReserved;
      LRValue := LScanArray[LXPos].rgbRed;
      LGValue := LScanArray[LXPos].rgbGreen;
      LBValue := LScanArray[LXPos].rgbBlue;

      if (RGB(LRValue, LGValue, LBValue) = 0) and (LAValue = 0) then begin
        LpRGBQuad^.rgbReserved :=  0;
      end else
      if (LAValue = 0) then begin
        LpRGBQuad^.rgbReserved := $FF;
      end else begin
        LpRGBQuad^.rgbRed := LRValue;
        LpRGBQuad^.rgbGreen := LGValue;
        LpRGBQuad^.rgbBlue := LBValue;
        LpRGBQuad^.rgbReserved := LScanArray[LXPos].rgbReserved;
      end;
      //色の塗り潰しの色指定が全てARGBで指定可能であればこの1行だけでよい
      //LpRGBQuad^.rgbReserved := LScanArray[LXPos].rgbReserved;
      Inc(LpRGBQuad);
    end;
    Inc(LScanLine, LDataStride);
  end;

  Result := True;
  DstGPBitmap.UnlockBits(LBmpData);
  SrcBitmap.Canvas.Unlock;
end;


end.


作成した関数の使用方法です．

 


procedure TForm1.Button1Click(Sender: TObject);

  // 略

  LBitmap := TBitmap.Create;
  try
    // 画像ファイルを読み込んで TImage に描画
    LBitmap.LoadFromFile('bug.bmp');
    FGPBitmap := TGPBitmap.Create(LBitmap.Width, LBitmap.Height);
    BitmapToGPBitmap(LBitmap, FGPBitmap);

  // 略

end;



04_関数化の例
SaveTextImage_TGPBitmap.zip　[1.1 MB]　2025年04月23日版 (EXE 同梱，説明なし)


こういった機能はメソッド，あるいは関数化した方が使い勝手がいいのですが，使用する場面によって引数などを考えた方がいいことがあります．以下は関数化の例です．


リスト3 
  public
    { Public 宣言 }
    FGPBitmap : TGPBitmap;
  end;

  function WriteImageText(AFilePath: string; AGPBitmap: TGPBitmap;
    AText: string): Integer;
  function ReadImageText(AFilePath: string; var AGPBitmap: TGPBitmap;
    var AText: string): Integer;

var
  Form1: TForm1;

implementation

// 略

//=============================================================================
///  保存・クリア
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LText : string;
begin
  LText := Memo1.Lines.text;
  if writeImageText('aaa.dat', FGPBitmap, LText) = 0 then Exit;

  Image1.Picture.Assign(nil);
  Memo1.Lines.Clear;
end;

//=============================================================================
///  読み出し
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LGPGraphics : TGPGraphics;
  LText       : string;
begin
  Image1.Picture.Assign(nil);
  Memo1.Lines.Clear;
  if ReadImageText('aaa.dat', FGPBitmap, LText) = 0 then Exit;

  Memo1.Lines.Text := LText;
  LGPGraphics := TGPGraphics.Create(Image1.Canvas.Handle);
  try
    LGPGraphics.DrawImage(FGPBitmap, 0, 0, Image1.Width, Image1.Height);
  finally
    FreeAndNil(LGPGraphics);
  end;
end;

//-----------------------------------------------------------------------------
//  テキスト + TGPBitmap ファイルへの書き込み用関数
//  戻り値は書き込んだバイト数
//-----------------------------------------------------------------------------
function WriteImageText(AFilePath: string; AGPBitmap: TGPBitmap;
  AText: string): Integer;
var
  LFileStream : TFileStream;
  LByteStream : TBytesStream;
  LStrList    : TStringList;
  LByteSize   : Integer;
  LImageGUID  : TGUID;
begin
  Result := 0;
  if not Assigned(AGPBitmap) then Exit;
  DeleteFile(AFilePath);

  LFileStream := TFileStream.Create(AFilePath, fmCreate);
  LByteStream := TBytesStream.Create;
  LStrList    := TStringList.Create;
  try
    LStrList.Text := AText;
    LByteStream.Clear;
    LStrList.SaveToStream(LByteStream, TEncoding.Unicode);
    LByteSize := LByteStream.Size;
    LFileStream.WriteData(LByteSize);
    LFileStream.Write(LByteStream.Bytes[0], LByteSize);

    LByteStream.Clear;
    GetEncoderClsid('image/png', LImageGUID);
    AGPBitmap.Save(TStreamAdapter.Create(LByteStream), LImageGUID);
    LByteSize := LByteStream.Size;
    LFileStream.WriteData(LByteSize);
    LFileStream.Write(LByteStream.Bytes[0], LByteSize);

    Result := LFileStream.Position;
  finally
    FreeAndNil(LFileStream);
    FreeAndNil(LByteStream);
    FreeAndNil(LStrList);
  end;
end;

//-----------------------------------------------------------------------------
//  テキスト + TGPBitmap ファイルからの読み出し用関数
//  戻り値は読み出したバイト数
//-----------------------------------------------------------------------------
function ReadImageText(AFilePath: string; var AGPBitmap: TGPBitmap;
  var AText: string): Integer;
var
  LFileStream : TFileStream;
  LByteStream : TBytesStream;
  LStrList    : TStringList;
  LByteSize   : Integer;
begin
  Result := 0;
  if not FileExists(AFilePath) then Exit;


  if Assigned(AGPBitmap) then FreeAndNil(AGPBitmap);

  LFileStream := TFileStream.Create(AFilePath, fmOpenRead);
  LByteStream := TBytesStream.Create;
  LStrList    := TstringList.Create;
  try
    TFileStream(LFileStream).ReadData(LByteSize);
    LByteStream.Size := LByteSize;
    LFileStream.Read(LByteStream.Bytes[0], LByteSize);
    LByteStream.Position := 0;
    LStrList.LoadFromStream(LByteStream, TEncoding.Unicode);
    AText := LStrList.Text;

    LFileStream.ReadData(LByteSize);
    LByteStream.Size := LByteSize;
    LFileStream.Read(LByteStream.Bytes[0], LByteSize);
    AGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(LByteStream));

    Result := LFileStream.Position;
  finally
    FreeAndNil(LFileStream);
    FreeAndNil(LByteStream);
    FreeAndNil(LStrList);
  end;
end;

end.