Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2017年05月04日] [更新 2017年07月03日]　GDI+ 関係サンプル
GDI+ 関係サンプル　
G020_画像の表示と表示サイズでの画像保存
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
G020_GDIPlus_SaveImage.zip　[6,998 KB]　2017年09月21日版 (EXE 同梱)






GDI+ による 画像の表示と表示画像の保存


GDI+ を使用して画像を描画する基本コードと，表示中の画像を保存するサンプルです．
GDI+ の一連のサンプルの多くは，画像を表示してその画像を加工したり処理するコードが追加されています．そこで，本ページでは，画像の表示と保存だけのサンプルとしています．本ページのサンプルでは GDI+ で描画中の画像をビットマップとして保存します．


[備考 1]
画像の拡大時における現象については以下の記事も確認してください．本ページのテストで使用しているビットマップ画像は背景が白いので目立ちませんが，実際には以下の記事で説明している現象が発生しています．


[備考 2]
TGPImage や TGPBitmap オブジェクトは，それらの Save メソッドを使用して保存できます．それらの Save メソッドは画像形式を指定して保存するようになっています．


[備考 3]
本ページには，ビットマップを生成して保存するサンプルがあります．ビットマップを他の画像形式に変換すれば他の画像形式で保存できます．





01_GDI+ による画像表示の基本コード


GDI+ で画像を表示する基本的と思われるコードです．以下の手順で実行しています．
  • 画像ファイルから TGPImage オブジェクトを生成
  • 描画先の TCanvas を指定して TGPGraphics オブジェクトを生成
  • TGPGraphics.DrawImage メソッドで TGPImage の情報を Canvas に描画
一連の GDI+ のサンプルでは，TPanel を継承したクラスの TCanvas に画像を描画しています．


図1
設計時画面
  • 描画用コントロールは実行時生成
図2
実行結果
  • 原寸で描画

リスト1
GDI+ による画像表示の基本コード		 
unit Unit1;

interface

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

type
  TMyPanel = class(TPanel)
  protected
    procedure Paint; override;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    MyPanel : TMyPanel;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'GDI+  画像を原寸表示';

  //TMyPanelを生成して配置
  MyPanel := TMyPanel.Create(Self);
  with MyPanel do begin
    Parent  := Self;
    Left    := 5;
    Top     := 35;
    Width   := Self.ClientWidth  - 10;
    Height  := Self.ClientHeight - Top - 5;
    Anchors := [akLeft, akTop, akRight, akBottom];
    Color   := clWhite;
    ParentBackground := False;
    DoubleBuffered   := True;
  end;
end;

{ TMyPanel }

//-----------------------------------------------------------------------------
//  TMyPanelクラスのPaintメソッド
//  実際の描画コード
//-----------------------------------------------------------------------------
procedure TMyPanel.Paint;
var
  LGPGraphic   : TGPGraphics;
  LGPImage     : TGPImage;
begin
  inherited;

  //画像ファイルを指定して，TGPImageのオブジェクトを生成
  LGPImage := TGPImage.Create(ExpandFileName('..\501.bmp'));

  //TGPGraphicsのオブジェクトを生成
  //描画先はこのTMyPanelのTCanvas
  LGPGraphic := TGPGraphics.Create(Canvas.Handle);

  //TGPImageをこのTMyPanelのTCanvasに描画
  LGPGraphic.DrawImage(LGPImage, 0, 0);

  //Createしたオブジェクトは解放処理する
  LGPImage.Free;
  LGPGraphic.Free;
end;

end.


フォームに配置した TImage に描画する場合は，例えば以下のように書けます．
GDI+ では Assign で画像を描画することはありませんから，TImage に描画する時は，このコードのように，Image1.Picture.Assign(nil) で画像をクリアしてから描画するようにします．

GDI+ による描画の特性を生かすには，TImage への描画をする必要はありません．本ページの TImaage への描画コードのサンプルは，問い合わせに対するレスの意味で掲載しています． 



unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    procedure DrawImage;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'GDI+  画像を原寸表示';

  //TImageの設定
  //オブジェクトインスペクタで設定可能
  with Image1 do begin
    Left    := 5;
    Top     := 35;
    Width   := Self.ClientWidth  - 10;
    Height  := Self.ClientHeight - Top - 5;
    Anchors := [akLeft, akTop, akRight, akBottom];
    ParentBackground := False;
    DoubleBuffered   := True;
  end;

  DrawImage;
end;

//-----------------------------------------------------------------------------
//  描画用メソッド
//-----------------------------------------------------------------------------
procedure TForm1.DrawImage;
var
  LGPGraphic   : TGPGraphics;
  LGPImage     : TGPImage;
begin
  Image1.Picture.Assign(nil);

  //画像ファイルを指定して，TGPImageのオブジェクトを生成
  LGPImage := TGPImage.Create(ExpandFileName('..\501.bmp'));

  //TGPGraphicsのオブジェクトを生成
  //描画先はこのTImaageのTCanvas
  LGPGraphic := TGPGraphics.Create(Image1.Canvas.Handle);

  //TGPImageを指定TCanvasに描画
  LGPGraphic.DrawImage(LGPImage, 0, 0);

  //Createしたオブジェクトは解放処理する
  LGPImage.Free;
  LGPGraphic.Free;
end;

end.


以下は，フォームの Canvas に直接描画する例です．Form1 の OnPaint イベントで描画しています． 



unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, GDIPOBJ, GDIPAPI;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  このフォームのOnPaintイベント
//=============================================================================
procedure TForm1.FormPaint(Sender: TObject);
var
  LGPGraphic : TGPGraphics;
  LGPImage   : TGPImage;
begin
  //画像ファイルからTGPImageオブジェクトを生成
  LGPImage := TGPImage.Create(ExpandFileName('..\501.bmp'));

  //このCanvasを描画先にしてTGPGraphicsを生成
  LGPGraphic := TGPGraphics.Create(Canvas.Handle);

  //そのCanvasにTGPImageの内容を描画する
  LGPGraphic.DrawImage(LGPImage, 10, 10);

  LGPGraphic.Free;
  LGPImage.Free;
end;

end.




02_GDI+ による StretchDraw な画像の描画


TImage の Stretch プロパティを True にするとストレッチな描画となります．これと同じ描画を実装するサンプルです．単に TGPGraphics の DrawImage メソッドの引数の指定で実現しています．
DrawImage メソッドには多くの overload 関数があり，元の画像の指定範囲だけの描画や，描画先の範囲の指定もできます．

本ページの TMyPanel を使用したサンプルの多くは，フォームをリサイズすると描画先のコントロールも同時にリサイズするようになっています．StretchDraw な描画動作を容易に確認できます．



図3
実行開始時の画面
  • 画像を読み込んで TMyPanel に表示
図4
フォームをリサイズ

リスト2
GDI+ による StretchDraw な画像の描画		 
unit Unit1;

interface

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

type
  TMyPanel = class(TPanel)
  protected
    procedure Paint; override;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    MyPanel : TMyPanel;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'GDI+  画像を拡大表示';

  //TMyPanelを生成して配置
  MyPanel := TMyPanel.Create(Self);
  with MyPanel do begin
    Parent  := Self;
    Left    := 5;
    Top     := 35;
    Width   := Self.ClientWidth  - 10;
    Height  := Self.ClientHeight - Top - 5;
    Anchors := [akLeft, akTop, akRight, akBottom];
    Color   := clWhite;
    ParentBackground := False;
    DoubleBuffered   := True;
  end;
end;

{ TMyPanel }

//-----------------------------------------------------------------------------
//  TMyPanelクラスのPaintメソッド
//  実際の描画コード
//-----------------------------------------------------------------------------
procedure TMyPanel.Paint;
var
  LGPGraphic   : TGPGraphics;
  LGPImage     : TGPImage;
begin
  inherited;

  //画像ファイルを指定して，TGPImageのオブジェクトを生成
  LGPImage := TGPImage.Create(ExpandFileName('..\501.bmp'));

  //TGPGraphicsのオブジェクトを生成
  //描画先はこのTMyPanelのTCanvas
  LGPGraphic := TGPGraphics.Create(Canvas.Handle);

  //TGPImageをこのTMyPanelのTCanvasに描画
  //TCanvasのStretchDrawに相当する
  LGPGraphic.DrawImage(
              LGPImage,
              MakeRect(0, 0, ClientWidth, ClientHeight),
              0,
              0,
              LGPImage.GetWidth,
              LGPImage.GetHeight,
              UnitPixel);

  //Createしたオブジェクトは解放処理する
  LGPImage.Free;
  LGPGraphic.Free;
end;

end.



03_GDI+ によるサイズ指定の画像描画と表示サイズでの画像保存


表示中の画像を保存するサンプルです．拡大あるいは縮小表示している場合，その表示サイズで，ビットマップ画像として保存します．
TGPGraphic.DrawImage メソッドは，描画用のコントロールに画像を表示するだけです．表示中のサイズで画像を保存するためには，その描画用のコントロールから画像としてのビットマップを取得しなけばなりません．ところが TPanel に描画してしまうのですから，描画した画像だけを取り出すということはできません．
そこで，保存用のビットマップを生成し，そこに描画して保存します．実行する描画のコードは，描画先の Canvas が異なるだけで全く同じです．次項サンプルのように，実際の描画部分だけを共通化することができます．


図5
実行開始時の画面
図6
フォームをリサイズ
  • TMyPanel の横幅を基準にして，縦横比を維持して描画する
  • [Button1] をクリックすると，このサイズのビットマップとして保存
  • 保存名は Save.bmp 固定
  • 保存場所は 1 つ上の階層のフォルダ

リスト3
GDI+ におけるサイズを指定した画像の描画と表示画像の保存
TGPGraphic.DrawImage メソッドを使用すると，元の画像の部分的な描画も可能		 
unit Unit1;

interface

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

type
  TMyPanel = class(TPanel)
  protected
    FGPGraphic    : TGPGraphics;
    FGPImage      : TGPImage;
    FOriginWidth  : Integer;
    FOriginHeight : Integer;
    FDrawWidth    : Integer;
    FDrawHeight   : Integer;
    procedure Paint; override;
  public
    procedure SaveImagee(AFileName: string);
    destructor Destroy; override;
  end;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'GDI+  画像を拡大表示';

  //TMyPanelを生成して配置
  MyPanel := TMyPanel.Create(Self);
  with MyPanel do begin
    Parent  := Self;
    Left    := 5;
    Top     := 35;
    Width   := Self.ClientWidth  - 10;
    Height  := Self.ClientHeight - Top - 5;
    Anchors := [akLeft, akTop, akRight, akBottom];
    Color   := clWhite;
    ParentBackground := False;
    DoubleBuffered   := True;
  end;
end;

//=============================================================================
//  保存ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSaveFileName : String;
begin
  LSaveFileName := ExpandFileName('..\Save.bmp');
  MyPanel.SaveImagee(LSaveFileName);
end;

{ TMyPanel }

//-----------------------------------------------------------------------------
//  TMyPanelクラス破棄時の処理
//-----------------------------------------------------------------------------
destructor TMyPanel.Destroy;
begin
  if Assigned(FGPImage) then FreeAndNil(FGPImage);
  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);

  inherited;
end;

//-----------------------------------------------------------------------------
//  TMyPanelのSaveImageToFileメソッド
//  保存のためのTBitmapを生成して保存
//-----------------------------------------------------------------------------
procedure TMyPanel.SaveImagee(AFileName: string);
var
  LBitmap : TBitmap;
begin
  if not Assigned(FGPImage) then exit;

  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);

  LBitmap := TBitmap.Create;
  try
    //ビットマップのサイズ設定
    LBitmap.SetSize(FDrawWidth, FDrawHeight);
    //描画先をビットマップのTCanvasとする
    //TMyPanleへの描画と違うのはここだけ
    FGPGraphic := TGPGraphics.Create(LBitmap.Canvas.Handle);

    //TGPImageをこのビットマップののTCanvasに描画
    FGPGraphic.DrawImage(
                FGPImage,
                MakeRect(0, 0, FDrawWidth, FDrawHeight),
                0,
                0,
                FOriginWidth,
                FOriginHeight,
                UnitPixel);
    LBitmap.SaveToFile(AFileName);
  finally
    FreeAndNil(LBitmap);
  end;

  //Createしたオブジェクトは解放処理する
  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);
end;

//-----------------------------------------------------------------------------
//  TMyPanelクラスのPaintメソッド
//  実際の描画コード
//-----------------------------------------------------------------------------
procedure TMyPanel.Paint;
var
  LRatio : Double;
begin
  inherited;

  if Assigned(FGPImage) then FreeAndNil(FGPImage);
  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);

  //画像ファイルを指定して，TGPImageのオブジェクトを生成
  FGPImage := TGPImage.Create(ExpandFileName('..\501.bmp'));
  //読み込んだ画像のサイズを取得
  FOriginWidth  := FGPImage.GetWidth;
  FOriginHeight := FGPImage.GetHeight;
  //縦横比を計算
  LRatio := FOriginHeight / FOriginWidth;

  //描画のサイズを計算
  FDrawWidth  := ClientWidth;
  FDrawHeight := Trunc(LRatio * FDrawWidth);

  //TGPGraphicsのオブジェクトを生成
  //描画先はこのTMyPanelのCanvas
  FGPGraphic := TGPGraphics.Create(Canvas.Handle);

  //GPImageをこのTMyPanelのCanvasに描画
  //TCanvasのStretchDrawに相当する
  FGPGraphic.DrawImage(
              FGPImage,
              MakeRect(0, 0, FDrawWidth, FDrawHeight),
              0,
              0,
              FOriginWidth,
              FOriginHeight,
              UnitPixel);

  //Createしたオブジェクトは解放処理する
  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);
end;

end.



04_GDI+ による画像描画で読み込んだ画像ファイルを不要にする


VCL の TImage では，画像を読み込んで表示すれば，元の画像ファイルが存在しなくても画像の操作が可能です．一方，これまでのサンプルでは，元の画像ファイルが移動したり削除されると画像そのものが表示されなくなります．これは，TGPImage オブジェクトのインスタンスが，画像ファイルから直接生成されているためです．

これを避けるには，画像をメモリストリームに読み込み，TGPImage をそのメモリストリームから生成するようにします．下に示すコードはその例です．
このような手法は，画像をディスク上の画像ファイルだけでなく，クリップボードから読み込んだり，他の画像関係のストリームから読み込む場合にも必要となります．



[備考]
画像の読み込みを Paint メソッド以外で行って TGPImage オブジェクトを生成するだけではこの現象は回避できません．



図7
設計時の画面
  • 機能は前項のサンプルと同じ
  • 保存先と保存ファイル名も前項のサンプルと同じ
  • [画像の読み込み] ボタンを追加

リスト4
画像を読み込んだら元の画像ファイルを不要にする方法
メモリストリームで画像ファイルを読み込む		 
unit Unit1;

interface

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

type
  TMyPanel = class(TPanel)
  protected
    FImageFilePath : string;
    FFileStream    : TMemoryStream;
    FGPGraphic     : TGPGraphics;
    FGPBitmap      : TGPBitmap;
    FDrawWidth     : Integer;
    FDrawHeight    : Integer;
    procedure Paint; override;
    procedure DrawImage(ACanvas: TCanvas; AWidth: Integer);
  public
    procedure LoadImageFromFile(AFileName: string);
    procedure SaveImageToFile(AFileName: string);
    destructor Destroy; override;
  end;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'GDI+  画像を拡大表示';

  //TMyPanelを生成して配置
  MyPanel := TMyPanel.Create(Self);
  with MyPanel do begin
    Parent  := Self;
    Left    := 5;
    Top     := 35;
    Width   := Self.ClientWidth  - 10;
    Height  := Self.ClientHeight - Top - 5;
    Anchors := [akLeft, akTop, akRight, akBottom];
    Color   := clWhite;
    ParentBackground := False;
    DoubleBuffered   := True;
  end;

  OpenPictureDialog1.InitialDir := ExpandFileName('..\');
  OpenPictureDialog1.FileName   :=  '501.bmp';
end;

//=============================================================================
//  画像の読み込みボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFileName : String;
begin
  if OpenPictureDialog1.Execute then begin
    LFileName := OpenPictureDialog1.FileName;
    OpenPictureDialog1.InitialDir := ExtractFileDir(LFileName);

    MyPanel.LoadImageFromFile(LFileName);
  end;
end;

//=============================================================================
//  保存ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LSaveFileName : String;
begin
  LSaveFileName := ExpandFileName('..\Save.bmp');
  MyPanel.SaveImageToFile(LSaveFileName);
end;

{ TMyPanel }

//-----------------------------------------------------------------------------
//  TMyPanelクラス破棄時の処理
//-----------------------------------------------------------------------------
destructor TMyPanel.Destroy;
begin
  if Assigned(FFileStream) then FreeAndNil(FFileStream);
  if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);
  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);

  inherited;
end;

//-----------------------------------------------------------------------------
//  TMyPanelのLoadImageFromFileメソッド
//
//  画像表示中に画像ファイルがなくても操作可能なようにメモリストリームに読み込む
//  そのメモリストリームからTGPBitmapを生成する
//
//  EMF,WMFはこのコードでは正常に読み込めない
//-----------------------------------------------------------------------------
procedure TMyPanel.LoadImageFromFile(AFileName: string);
var
  LStream : TMemoryStream;
begin
  if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);
  if Assigned(FFileStream) then FreeAndNil(FFileStream);

  LStream := TMemoryStream.Create;

  LStream.LoadFromFile(AFileName);
  //メモリストリームから読み出してTGPBitmapを生成
  //TGPBitmapを使用
  //TGPImageだと正常に読み込めないメタファイルがある
  FGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(LStream, soReference));

  Invalidate;
end;

//-----------------------------------------------------------------------------
//  TMyPanelのSaveImageToFileメソッド
//  保存のためのTBitmapを生成して保存
//-----------------------------------------------------------------------------
procedure TMyPanel.SaveImageToFile(AFileName: string);
var
  LBitmap : TBitmap;
begin
  LBitmap := TBitmap.Create;
  try
    //ビットマップのサイズ設定
    LBitmap.SetSize(FDrawWidth, FDrawHeight);
    //描画先をビットマップのTCanvasとする
    DrawImage(LBitmap.Canvas, LBitmap.Width);
    LBitmap.SaveToFile(AFileName);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//-----------------------------------------------------------------------------
//  描画ルーチン
//
//  ACanvas : 画面に表示する時は描画用コントロールのTCanas
//          : 保存する時は保存用ビットマップのTCanvas 　
//  AWidth  : 画像の描画幅
//-----------------------------------------------------------------------------
procedure TMyPanel.DrawImage(ACanvas: TCanvas; AWidth: Integer);
var
  LRatio : Double;
begin
  if not Assigned(FGPBitmap) then exit;
  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);

  //縦横比を計算
  LRatio := FGPBitmap.GetHeight / FGPBitmap.GetWidth;

  //描画のサイズを計算
  FDrawWidth  := AWidth;
  FDrawHeight := Trunc(LRatio * FDrawWidth);

  //TGPGraphicsのオブジェクトを生成
  //描画先は引数のTCanvas
  FGPGraphic := TGPGraphics.Create(ACanvas.Handle);

  //GPImageをこのTMyPanelのCanvasに描画
  //TCanvasのStretchDrawに相当する
  FGPGraphic.DrawImage(
              FGPBitmap,
              MakeRect(0, 0, FDrawWidth, FDrawHeight),
              0,
              0,
              FGPBitmap.GetWidth,
              FGPBitmap.GetHeight,
              UnitPixel);

  //Createしたオブジェクトは解放処理する
  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);
end;

//-----------------------------------------------------------------------------
//  TMyPanelクラスのPaintメソッド
//-----------------------------------------------------------------------------
procedure TMyPanel.Paint;
begin
  inherited;
  DrawImage(Canvas, ClientWidth);
end;

end.



05_GDI+ による TImage への画像表示


ここまでのサンプルでは，TPanel を継承した自前の TMyPanel というコントロールに画像を表示しています．TMyPanel を TImage あるいは TPaintBox の代わりに使用していることになります．
本サンプルは TImage に画像を表示する例です．
TImage に描画した場合，TImage は内部のビットマップに描画情報があります．したがって，上のサンプルのように，保存用のビットマップを改めて作成する必要はありません．

本サンプルは，フォームのリサイズで TImage はリサイズしません．TImage のサイズを TSpinEdit の値で変更するようにしています．



図8
画像を読み込んで表示したところ
図9
リサイズ
  • 左の TSpinEdit の値を変更すると TImage の幅が変わる
  • 縦横比を維持して TImage の高さも変わる
  • 保存先と保存ファイル名も前項のサンプルと同じ

リスト5
GDI+ による TImage への画像表示		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    OpenPictureDialog1: TOpenPictureDialog;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
  private
    { Private 宣言 }
    FFileStream : TMemoryStream;
    FGPGraphic  : TGPGraphics;
    FGPBitmap   : TGPBitmap;
    procedure GDIDrawImageToTImage;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'GDI+  TImage に画像を描画';

  SpinEdit1.Value := Image1.Width;
  SpinEdit2.Value := Image1.Height;

  OpenPictureDialog1.InitialDir := ExpandFileName('..\');
  OpenPictureDialog1.FileName   :=  '501.bmp';
end;

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

//=============================================================================
//  画像の読み込みボタン
//
//  画像表示中に画像ファイルがなくても操作可能なようにメモリストリームに読み込む
//  そのメモリストリームからTGPBitmapを生成する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFileName : string;
begin
  if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);
  if Assigned(FFileStream) then FreeAndNil(FFileStream);

  if OpenPictureDialog1.Execute then begin
    LFileName := OpenPictureDialog1.FileName;
    OpenPictureDialog1.InitialDir := ExtractFileDir(LFileName);

    FFileStream := TMemoryStream.Create;
    FFileStream.LoadFromFile(LFileName);
    //メモリストリームから読み出してTGPBitmapを生成
    //TGPBitmapを使用
    //TGPImageだと正常に読み込めないメタファイルがある
    FGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(FFileStream, soReference));

    //描画サイズはTSpinEditの値に従う
    SpinEdit1Change(nil);
  end;
end;

//=============================================================================
//  保存ボタン
//  保存のためのTBitmapを生成して保存
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LSaveFileName : string;
  LBitmap       : TBitmap;
begin
  if not Assigned(FGPBitmap) then exit;

  LSaveFileName := ExpandFileName('..\Save.bmp');
  LBitmap := TBitmap.Create;
  try
    LBitmap.Assign(Image1.Picture.Bitmap);
    LBitmap.SaveToFile(LSaveFileName);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  SpinEdit1のOnChangeイベント処理
//  TImageの幅(画像の表示幅)を設定
//  SpinEdit2(TImageの高さ)はReadOnlyにしている
//=============================================================================
procedure TForm1.SpinEdit1Change(Sender: TObject);
var
  LRatio : Double;
begin
  if not Assigned(FGPBitmap) then exit;
  if FGPBitmap.GetWidth <= 0 then exit;

  Image1.Picture.Assign(nil);

  //縦横比を計算
  //縦横比を維持して描画する
  LRatio := FGPBitmap.GetHeight / FGPBitmap.GetWidth;
  Image1.Width  := SpinEdit1.Value;
  Image1.Height := Trunc(LRatio * Image1.Width);
  SpinEdit2.Value := Image1.Height;

  GDIDrawImageToTImage;
end;

//-----------------------------------------------------------------------------
//  実際の描画コード
//  FGPGraphic.SetInterpolationMode(InterpolationModeNearestNeighbor);
//  を実行するとTImage.Canvas.StretchDrawとほぼ同じ品質になる
//-----------------------------------------------------------------------------
procedure TForm1.GDIDrawImageToTImage;
begin
  if not Assigned(FGPBitmap) then exit;
  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);

  //TGPGraphicsのオブジェクトを生成
  //描画先はこのTImageのCanvas
  FGPGraphic := TGPGraphics.Create(Image1.Canvas.Handle);

  //TGPBitmapをこのTImageのCanvasに描画
  FGPGraphic.DrawImage(
              FGPBitmap,
              MakeRect(0, 0, Image1.Width, Image1.Height),
              0,
              0,
              FGPBitmap.GetWidth,
              FGPBitmap.GetHeight,
              UnitPixel);

  //Createしたオブジェクトは解放処理する
  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);
end;

end.



06_透過色を指定してビットマップ画像を GDI+ で描画


読み込んだビットマップ画像を TGPBitmap にして，透過色を指定して描画するサンプルです．
透過色は描画開始前に設定します．このサンプルでは (0, 0) のピクセルの色を透過色として設定します．これは画像の左下のピクセルの色です．透過色を設定には TGPImageAttr.SetColorKey メソッドを使用します．

GDI+ は，内部で 32 ビットのアルファチャンネル付きのビットマップとして処理します．指定した透過色のピクセルのアルファ値は 0 となります．そのため，32 ビットのアルファチャンネル付きビットマップでアルファ値が 0 のピクセルも，色が黒のピクセルも透過して描画します．



図10
透過色の指定をしないで描画した場合
図11
透過色の設定をして描画した場合
図12
32 ビットのアルファ値が 0 のピクセルがあるビットマップ画像の場合
  • ヒヨコの目の黒い部分が透過している
  • 輪郭など完全な黒ではない部分は透過しない

リスト6
透過色を指定してビットマップを描画する例
前項のサンプルの描画コードを以下のように変更		 
//-----------------------------------------------------------------------------
//  実際の描画コード
//  透過色を指定したビットマップの描画
//-----------------------------------------------------------------------------
procedure TForm1.GDIDrawImageToTImage;
var
  LGPImageAttr : TGPImageAttributes;
  LGPColor     : TGPColor;
begin
  if not Assigned(FGPBitmap) then exit;
  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);

  //TGPGraphicsのオブジェクトを生成
  //描画先はこのTImageのCanvas
  FGPGraphic := TGPGraphics.Create(Image1.Canvas.Handle);

  //画像のピクセル(0, 0)の色を透過色とする
  FGPBitmap.GetPixel(0, 0, LGPColor);
  LGPImageAttr := TGPImageAttributes.Create;
  LGPImageAttr.SetColorKey(LGPColor, LGPColor);

  //TGPBitmapをこのTImageのCanvasに描画
  FGPGraphic.DrawImage(
              FGPBitmap,
              MakeRect(0, 0, Image1.Width, Image1.Height),
              0,
              0,
              FGPBitmap.GetWidth,
              FGPBitmap.GetHeight,
              UnitPixel,
              LGPImageAttr);   //属性を指定する

  //Createしたオブジェクトは解放処理する
  if Assigned(FGPGraphic) then FreeAndNil(FGPGraphic);
end;



07_アルファチャンネル付きビットマップ画像を GDI+ で描画


Delphi 2009 で TBitmap にアルファチャンネルの機能が実装されまた．TImage にもアルファチャンネル付きの画像の描画機能が実装されました．

GDI+ は，ビットマップのアルファチャンネルの値を自動では処理してくれません．アルファ値が 0 は何も描画しない，つまり，透明となるのですが，GDI+ で描画すると黒となってしまいます．

本項のサンプルは，TGPBitmap をアルファチャンネル付きのビットマップにして，そのアルファ値に元のビットマップのアルファ値を代入する方法です．この方法であれば半透明のビットマップ画像も GDI+ で描画することができます．




[備考]
アルファチャンネル付きのビットマップは，アルファチャンネル付きのビットマップを表示できるアプリケーションでなければ正しく表示できません．Photoshop (どのバージョンからかは不明) ではサポートしているようです．また，現在は多くのウェブブラウザがアルファチャンネル付き画像の表示が可能となっていますが，ビットマップのアルファチャンネルはサポートしていません．


図13
アルファチャンネルの処理をしない場合
  • 背景の黒い部分が透明色ピクセル
  • 見た限りでは画像の「黒」との区別はつかない
図14
アルファチャンネルの処理をした場合
図15
半透明のビットマップ画像の場合

リスト7
アルファチャンネル付きビットマップ画像を GDI+ で描画		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    OpenPictureDialog1: TOpenPictureDialog;
    CheckBox1: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    function SetAlphaValueFromTBitmap(DstGPBitmap: TGPBitmap;
      SrcBitmap: TBitmap): Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  CheckBox1.Checked := True;

  OpenPictureDialog1.InitialDir := ExtractFileDir(Application.ExeName);
  OpenPictureDialog1.FileName   :=  '501.bmp';
end;

//=============================================================================
//  アルファチャンネル付きビットマップを読み込んで描画するテスト
//  32ビット以外のビットマップでは透過色の処理も行う
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFileName     : string;
  LFormatFlag   : Boolean;
  LOriginBitmap : TBitmap;
  LBitmap       : TBitmap;
  LStream       : TMemoryStream;
  LGPGraphic    : TGPGraphics;
  LGPBitmap     : TGPBitmap;
  LGPBitmapReff : TGPBitmap;
  LGPImageAttr  : TGPImageAttributes;
  LGPColor      : TGPColor;
begin
  Image1.Picture.Assign(nil);
  if not OpenPictureDialog1.Execute then exit;

  LFileName := OpenPictureDialog1.FileName;
  OpenPictureDialog1.InitialDir := ExtractFileDir(LFileName);

  LOriginBitmap := TBitmap.Create;
  LBitmap       := TBitmap.Create;
  LStream       := TMemoryStream.Create;
  try
    //ファイルから読み込む
    //アルファチャンネルが使用可能なのは32ビットだけなのでチェック
    LOriginBitmap.LoadFromFile(LFileName);
    LFormatFlag := LOriginBitmap.PixelFormat = pf32bit;

    //操作用の別のビットマップを作成して描画
    LBitmap.PixelFormat := pf32bit;
    LBitmap.SetSize(LOriginBitmap.Width, LOriginBitmap.Height);
    LBitmap.Canvas.Draw(0, 0, LOriginBitmap);

    //メモリストリームからTGPBitmapを生成
    LBitmap.SaveToStream(LStream);
    LGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(LStream, soReference));

    LGPImageAttr := nil;
    //アルファ値と透過色の設定処理
    if CheckBox1.Checked then begin
      if LFormatFlag then begin
        SetAlphaValueFromTBitmap(LGPBitmap, LBitmap);
      end else begin
        //画像のピクセル(0, 0)の色を透過色とする
        LGPBitmap.GetPixel(0, 0, LGPColor);
        LGPImageAttr := TGPImageAttributes.Create;
        LGPImageAttr.SetColorKey(LGPColor, LGPColor);
      end;
    end;

    //透過状態を確認するために背景に描画するビットマップ画像
    LGPBitmapReff := TGPBitmap.Create('502.bmp');

    LGPGraphic := TGPGraphics.Create(Image1.Canvas.Handle);

    LGPGraphic.DrawImage(LGPBitmapReff, 10, 10);
    //透過処理付きの描画コード
    LGPGraphic.DrawImage(
                LGPBitmap,
                MakeRect(40, 40, LGPBitmap.GetWidth, LGPBitmap.GetHeight),
                0,
                0,
                LGPBitmap.GetWidth,
                LGPBitmap.GetHeight,
                UnitPixel,
                LGPImageAttr);   //属性を指定する
  finally
    LOriginBitmap.Free;
    LBitmap.Free;
    LStream.Free;
  end;

  LGPBitmap.Free;
  LGPBitmapReff.Free;
  LGPGraphic.Free;
  LGPImageAttr.Free;
end;

//-----------------------------------------------------------------------------
//  読み込んだビットマップ(TBitmap)画像のアルファ値の処理
//
//  TGPBitmapはTBitmapのアルファチャンネルを処理しない
//  TBitmapのアルファ値をTGPBitmapのアルファ値に代入する
//  アルファチャンネル付きTBitmapをアルファチャンネル付きで表示可能にする
//  元のビット深さが32bit以上用
//-----------------------------------------------------------------------------
function TForm1.SetAlphaValueFromTBitmap(DstGPBitmap: TGPBitmap;
  SrcBitmap: TBitmap): 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;

  LWidth  := DstGPBitmap.GetWidth;
  LHeight := DstGPBitmap.GetHeight;

  //TGPBitmapのビットマップデータ取得
  if DstGPBitmap.LockBits(MakeRect(0, 0, LWidth, LHeight), ImageLockModeWrite,
                                 PixelFormat32bppARGB, LBmpData) <> Ok then exit;

  SrcBitmap.Canvas.Lock;

  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 MakeColor(LRValue, LGValue, LBValue, LAValue) = 0 then begin
        LpRGBQuad^.rgbReserved :=  0;
      end else
      if (LAValue = 0) then begin
        LpRGBQuad^.rgbReserved := $FF;
      end else begin
        LpRGBQuad^.rgbReserved := LScanArray[LXPos].rgbReserved;
      end;
      Inc(LpRGBQuad);
    end;
    Inc(LScanLine, LDataStride);
  end;

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

end.


GDI+ の TGPBitmap.Create メソッドにはいくつかのオーバーロード関数があり， その中にビットマップのハンドルとビットマップのヘッダ情報から生成する関数があります．
以下のコードはその例ですが，確かに半透明で描画されましたが，このコードでは上下が反転した状態で表示されました．RotateFlip 関数あるいは RotateTransform 関数を使用すれば上下を反転できますが，ピクセルを直接操作する方法の方が確実のようです．



図16
実行結果

リスト8
ビットマップのハンドルから GDI+ のビットマップ (TGPBitmap) を生成する例		 
//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  OpenPictureDialog1.InitialDir := ExtractFileDir(Application.ExeName);
  OpenPictureDialog1.FileName   :=  '501.bmp';
end;

//=============================================================================
//  アルファチャンネル付きビットマップを読み込んで描画するテスト
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFileName   : string;
  LBitmap     : TBitmap;
  LGPGraphic  : TGPGraphics;
  LGPBitmap   : TGPBitmap;
  LBitmapInfo : tagBITMAP;
  LpBmpBits   : Pointer;
begin
  Image1.Picture.Assign(nil);
  if not OpenPictureDialog1.Execute then exit;

  LFileName := OpenPictureDialog1.FileName;
  OpenPictureDialog1.InitialDir := ExtractFileDir(LFileName);

  LBitmap := TBitmap.Create;
  try
    LBitmap.PixelFormat := pf32bit;
    LBitmap.LoadFromFile(LFileName);

    //ビットマップハンドルからビットマップの情報を取得
    GetObject(LBitmap.Handle, SizeOf(LBitmapInfo), @LBitmapInfo);

    LpBmpBits := LBitmapInfo.bmBits;
    LGPBitmap := TGPBitmap.Create(LBitmap.Width,
                                  LBitmap.Height,
                                  LBitmap.Width * 4,
                                  PixelFormat32bppARGB,
                                  PByte(LpBmpBits));


    LGPGraphic := TGPGraphics.Create(Image1.Canvas.Handle);
    LGPGraphic.DrawImage(LGPBitmap, 0, 0);
  finally
    LBitmap.Free;
    LGPBitmap.Free;
    FreeAndNil(LGPGraphic);
  end;
end;



08_画素 ( ピクセル ) の色変更とアルファチャンネル


前項でアルファチャンネル付きのビットマップを GDI+ で正常に扱うための処理を追加しました．
アルファチャンネルの扱いについては，アルファ値そのものにも注意が必要です．

本サンプルは，マウスでクリックしたピクセルと同じ色のピクセルを別の色にしますが，この時「透明」なピクセルを対象とした時の動作を確認するものです．ピクセルの操作ということで，ピクセルの色をグリッド表示していますが，テストの本質とは直接の関係はありません．

EXE を起動したら添付の agt_business.png という PNG 画像を読み込んで表示します．そして「透明」なピクセルをマウスでクリックします．ところが「透明」なピクセルの全てが変更できません．
TEdit に表示された色の値を見ると，アルファ値は確かに 0 となっていて「透明」なのですが，RGB の値は 0 ではありません．つまり「透明色」ではありません．



図17
設計時の画面
  • TImage を 2 つ配置
  • 上の TImage は元サイズの画像を表示
  • 下の TImage は拡大表示してピクセルを表示
  • TEdit はマウスクリックの色の値を表示
図18
添付の画像を読み込んで表示
図19
「透明」なピクセルをクリック
  • 透明な全てのピクセルの色が変わるわけではない

再度同じ画像を読み込んで，今度は別の「透明」なピクセルをクリックします．今度も全ての「透明」なピクセルが変更されません．ピクセルの色の値を見ると確かにアルファ値は 0 となっていて「透明」なのですが，RGB の値は 0 ではありません．
GDI+ ての色の指定は「色」で指定します．アルファだけの特別扱いの関数はありません


図20
画像を再読み込みしてマウスで「透明」なピクセルをクリック

以下のコードには，この現象を回避するための処理が追加されています．この処理は PNG 形式の画像を読み込んだら，アルファ値が 0 のピクセルを全て「透明色」にします．
その処理を使用した結果が下図です．[アルファ値処理なし] のチェックを外してから画像を読み込みます．全ての「透明色」のピクセルの色が変更されています．


図21
「透明」なピクセルを「透明色」にしてから操作

テスト用の PNG 画像を読み出します．そして，TGPBitmap を生成して，アルファチャンネルの処理した直後に，以下の記事の TGPBitam.Save メソッドでディスクに画像を保存した結果です．
左からビットマップ画像，GIF 形式の画像，JPEG 形式の画像です．この画像はエクスプローラでの表示画像です．

ビットマップ画像の背景は透明色です．透過色の情報がなくなっているので GIF 画像の背景は「黒」です．JPEG 画像は元々透過色の機能がありませんから当然「黒」です．
このままでは背景の黒と画像の黒と区別が付きません．GIF 画像の場合，背景を透過状態にすることがあります．したがって GIF 画像として保存する時は，改めて背景を別の色で塗り潰して，その色を透過色に指定する等の工夫が必要となります．



図22
他の画像形式で保存した結果
  • 一番左のビットマップ画像の背景は「黒」ではなく「透明色」

下図はアルファチャンネルの処理をしないで保存した場合です．
一番左はビットマップ画像です．左から 2 番目の GIF 画像の色数は最大 256 色です．PNG で使用されている透明色が GIF 画像で使われるとは限りません．したがって透明部分はありません．JPEG 画像は説明の必要はないでしょう．

この結果は，元の PNG 形式画像を忠実に再現していると言えます．



図23
アルファチャンネルの処理をしないで他の画像形式で保存した場合

プロシージャー名 機能
DrawPixelColorToTImage 画像を拡大表示してピクセルの色を TImage にグリッド表示
SetAlphaValueFromTBitmap 読み込んだビットマップのアルファ値を TGPBitmap にセット
GDI+ でビットマップ画像のアルファ値を扱うための処理
SetAlphaZeroPixelsSelfTGPBitmap 読み込んだ PNG 形式画像の透明色の再設定
GDI+ で PNG 形式画像の透過色を扱うための処理
ChangeColor 指定した色のピクセルを別の色に変更



リスト9
画素 (ピクセル) の色変更とアルファチャンネル．ピクセルの色をグリッド表示付き
上の表のメソッド類を作成して使用している		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, GDIPAPI, GDIPOBJ, ComCtrls, Spin, Grids, ExtDlgs;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Image1: TImage;
    Image2: TImage;
    ComboBox1: TComboBox;
    Edit1: TEdit;
    CheckBox1: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseLeave(Sender: TObject);
  private
    { Privat  e 宣言 }
    FInitDir        : string;
    FPicelRectSize  : Integer;
    FPixelGridColor : TColor;
    FMemStream      : TBytesStream;
    FGPBitmap       : TGPBitmap;
   function SetAlphaValueFromTBitmap(DstGPBitmap: TGPBitmap;
     SrcBitmap: TBitmap): Boolean;
   function SetAlphaZeroPixelsSelfTGPBitmap(TargetGDPBmp: TGPBitmap;
     TransAlphaLevel: Byte = 0; IsGIFFile: Boolean = False): Boolean;
    function ChangeColor(TarGPBitmap: TGPBitmap; OldColor, NewColor: TGPColor):
      Boolean;
  public
    { Public 宣言 }
    procedure DrawPixelColorToTImage(SrcGPBitmap: TGPBitmap; DrawTimage: TImage;
      PixelRectSize: Integer; MaxImgPixels: Integer; GridLineColor: TColor;
      BackImage: TBitmap = nil; ShowGridLine: Boolean = True;
      BackGround: Boolean = True);
  end;

var
  Form1: TForm1;

implementation

uses
  StrUtils;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  CheckBox1.Checked := True;

  ComboBox1.Items.Clear;
  ComboBox1.Items.Add('3');
  ComboBox1.Items.Add('4');
  ComboBox1.Items.Add('5');
  ComboBox1.Items.Add('6');
  ComboBox1.Items.Add('7');
  ComboBox1.Items.Add('8');
  ComboBox1.Items.Add('9');
  ComboBox1.Items.Add('10');
  ComboBox1.Items.Add('12');
  ComboBox1.Items.Add('15');

  FInitDir        := ExpandFileName('.\TestImages');
  FPixelGridColor := clGray;
  FPicelRectSize  := 5;
  ComboBox1.ItemIndex := ComboBox1.Items.IndexOf(IntToStr(FPicelRectSize));

  Image1.Transparent := False;
  Image2.Transparent := False;
end;

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

//=============================================================================
//  画像ファイルを読み込んで表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);

  //---------------------------------------------------------------------------
  //  画像ファイルの形式を調べる関数(簡易版)
  //  館実に取得するにはMIMEタイプで調べた方がいいかも知れない
  //---------------------------------------------------------------------------
  function GetImageTypeStr(ABytesStream: TBytesStream): string;
  var
    LText : string;
    i     : Integer;
  begin
    Result := '';

    LText := '';
    for i := 0 to 6 do begin
      LText := LText + Char(FMemStream.Bytes[i]);
    end;
    LText := Trim(LText);
    if LeftStr(LText, 2) = 'BM' then begin
      Result := 'BITMAP';
    end else
    if Copy(LText, 2, 3) = 'PNG' then begin
      Result := 'PNG';
    end else
    if LeftStr(LText, 6) = 'GIF89a' then begin
      Result := 'GIF';
    end;
  end;
  //---------------------------------------------------------------------------

var
  LImgType　 : string;
  LBitmap    : TBitmap;
  LGPGraphic : TGPGraphics;
begin
  OpenPictureDialog1.Filter     := '画像ファイル|*.png;*.jpg;*.bmp;*.gif;*.ico';
  OpenPictureDialog1.InitialDir := FInitDir;
  if not OpenPictureDialog1.Execute then exit;

  FInitDir :=  ExtractFileDir(OpenPictureDialog1.FileName);


  Image2.Picture.Assign(nil);

  if Assigned(FGPBitmap)  then FreeAndNil(FGPBitmap);
  if Assigned(FMemStream) then FreeAndNil(FMemStream);

  //メモリストリームに画像ファイルを読み込む
  FMemStream := TBytesStream.Create;
  FMemStream.LoadFromFile(OpenPictureDialog1.FileName);

  //画像ファイルの形式を調べる
  LImgType := GetImageTypeStr(FMemStream);

  //ビットマップ形式の画像の場合
  //アルファチャンネルの画像をアルファチャンネル付きで描画可能にする
  if LImgType = 'BITMAP' then begin
    LBitmap := TBitmap.Create;
    try
      LBitmap.LoadFromStream(FMemStream);
      FGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(FMemStream, soReference));
      if LBitmap.PixelFormat = pf32bit then begin
        SetAlphaValueFromTBitmap(FGPBitmap, LBitmap);
      end;
    finally
      FreeAndNil(LBitmap);
    end;
  end else
  //PNG形式の画像の場合はアルファ値が0のピクセルを透明色にする操作を行う
  if LImgType = 'PNG' then begin
    FGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(FMemStream, soReference));
    if not CheckBox1.Checked then begin
      SetAlphaZeroPixelsSelfTGPBitmap(FGPBitmap);
    end;
  end else begin
    FGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(FMemStream, soReference));
  end;


  //作成したTGPBitmapをTImageに描画
  LGPGraphic := TGPGraphics.Create(Image2.Canvas.Handle);
  LGPGraphic.DrawImage(FGPBitmap, 0, 0);

  //ピクセルのグリッド表示
  DrawPixelColorToTImage(FGPBitmap, Image1, FPicelRectSize, 512, FPixelGridColor);

  FreeAndNil(LGPGraphic);
end;

//=============================================================================
//  ComboBox1のOnChangeイベント処理
//  ピクセルのグリッド表示のグリッドのセルのサイズを変更
//=============================================================================
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  FPicelRectSize := StrToInt(ComboBox1.Text);
  if not Assigned(FGPBitmap) then exit;

  DrawPixelColorToTImage(FGPBitmap, Image1, FPicelRectSize, 512, FPixelGridColor);
end;

//=============================================================================
//  Image1のOnMouseDownイベント処理
//  マウスで選択したピクセルと同じ色を別の色に変更
//=============================================================================
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  LXPos      : Integer;
  LYPos      : Integer;
  LGPColor   : TGPColor;
  LGPGraphic : TGPGraphics;
begin
  if not Assigned(FGPBitmap) then exit;
  if (Button <> mbLeft) then exit;

  //実際の画像のピクセルの位置に変換
  LXPos := X div FPicelRectSize;
  LYPos := Y div FPicelRectSize;

  //ピクセルの色を取得
  if FGPBitmap.GetPixel(LXPos, LYPos, LGPColor) = Ok then begin

    Edit1.Text := '$' + IntToHex(LGPColor, 8);


    //指定した色のピクセルの色を変更
    ChangeColor(FGPBitmap, LGPColor, MakeColor(255, 0, 120, 20));

    Image2.Picture.Assign(nil);

    //変更結果のTGPBitmapをTImageに描画する
    LGPGraphic := TGPGraphics.Create(Image2.Canvas.Handle);
    LGPGraphic.DrawImage(FGPBitmap, 0,0);
    FreeAndNil(LGPGraphic);

    //実行結果をピクセルのグリッド表示にも反映する
    DrawPixelColorToTImage(FGPBitmap, Image1, FPicelRectSize, 512, FPixelGridColor);
  end;
end;

//=============================================================================
//  Image1のOnMouseMoveイベント処理
//  マウスでカーソル下のピクセルの色を取得してTEdiに表示
//=============================================================================
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  LXPos      : Integer;
  LYPos      : Integer;
  LGPColor   : TGPColor;
begin
  if not Assigned(FGPBitmap) then exit;

  //実際の画像のピクセルの位置に変換
  LXPos := X div FPicelRectSize;
  LYPos := Y div FPicelRectSize;

  if FGPBitmap.GetPixel(LXPos, LYPos, LGPColor) = Ok then begin
    Edit1.Text := '$' + IntToHex(LGPColor, 8);
  end;
end;

//=============================================================================
//  Image1のOnMouseLeaveイベント処理
//=============================================================================
procedure TForm1.Image1MouseLeave(Sender: TObject);
begin
  Edit1.Text := '';
end;

//-----------------------------------------------------------------------------
//  TGPBitmapの各ピクセルの色をグリッド表示
//-----------------------------------------------------------------------------
procedure TForm1.DrawPixelColorToTImage(SrcGPBitmap: TGPBitmap;
  DrawTimage: TImage; PixelRectSize: Integer;  MaxImgPixels: Integer;
  GridLineColor: TColor; BackImage: TBitmap = nil; ShowGridLine: Boolean = True;
  BackGround: Boolean = True);
type
  TRGBQArray = array [0..4095] of RGBQUAD;
  PRGBQArray = ^TRGBQArray;
var
  LSrcImgWidth  : Integer;
  LSrcImgHeight : Integer;
  LImgWidth     : Integer;
  LImgHeight    : Integer;
  LBmpData      : TBitmapData;
  LScanLine     : PByte;
  LpRGBQuad     : PRGBQuad;
  LDataStride   : Integer;
  LAValue       : Byte;
  LRValue       : Byte;
  LGValue       : Byte;
  LBValue       : Byte;
  LXPos         : Integer;
  LYPos         : Integer;
  LImgBitmap    : TBitmap;
  LDstScanArray : PRGBQArray;
  LiiX          : Integer;
  LiiY          : Integer;
  LGridRValue   : Byte;
  LGridGValue   : Byte;
  LGridBValue   : Byte;
  LBitmap       : TBitmap;
begin
  DrawTimage.Picture.Assign(nil);

  //画像のサイズを取得
  LSrcImgWidth  := SrcGPBitmap.GetWidth;
  LSrcImgHeight := SrcGPBitmap.GetHeight;
  if LSrcImgWidth > MaxImgPixels  then LSrcImgWidth  := MaxImgPixels;
  if LSrcImgHeight > MaxImgPixels then LSrcImgHeight := MaxImgPixels;

  //グリッド表示の描画サイズ
  LImgWidth  := LSrcImgWidth * PixelRectSize + 1;
  LImgHeight := LSrcImgHeight * PixelRectSize + 1;

  //背景画像の指定があれば描画
  if (Assigned(BackImage)) and BackGround then begin
    DrawTimage.Canvas.Brush.Bitmap := BackImage;
    DrawTimage.Canvas.FillRect(DrawTimage.ClientRect);
  end;


  //TGPBitmapのビットマップデータ取得
  if SrcGPBitmap.LockBits(MakeRect(0, 0, LSrcImgWidth, LSrcImgHeight),
             ImageLockModeRead, PixelFormat32bppARGB, LBmpData) <> Ok then exit;

  //ピクセルとグリッド線を描画するTBitmapを作成
  //ここに描画した後にTImageのCanvasに描画する
  LImgBitmap := TBitmap.Create;
  try
    LImgBitmap.SetSize(LImgWidth, LImgHeight);
    LImgBitmap.PixelFormat := pf32bit;
    //AlphaFormat := afIgnoredとしておく
    //afIgnoredにしないて半透明のピクセルが正常に描画できない
    //TImage.Canvasに描画する時にafDefinedにする
    LImgBitmap.AlphaFormat := afIgnored;

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

    //グリッド線の色のRGB値を取得しておく
    LGridRValue := GetRValue(GridLineColor);
    LGridGValue := GetGValue(GridLineColor);
    LGridBValue := GetBValue(GridLineColor);

    for LYPos := 0 to LSrcImgHeight - 1 do begin
      LpRGBQuad := PRGBQuad(LScanLine);
      LImgBitmap.Canvas.Lock;

      for LXPos := 0 to LSrcImgWidth - 1 do begin

        LAValue := LpRGBQuad^.rgbReserved;
        LRValue := LpRGBQuad^.rgbRed;
        LGValue := LpRGBQuad^.rgbGreen;
        LBValue := LpRGBQuad^.rgbBlue;

        for LiiY := 0 to PixelRectSize do begin
          LDstScanArray  := LImgBitmap.ScanLine[LYPos * PixelRectSize + LiiY];

          //この部分がグリッドへの描画
          for LiiX := 0 to PixelRectSize do begin
            //グリッドを描画する座標値の時
            if (ShowGridLine) and ((LiiY = 0) or (LiiX = 0) or
              (LiiY = PixelRectSize) or (LiiX = PixelRectSize)) then begin
              LDstScanArray[LXPos * PixelRectSize + LiiX].rgbReserved := $FF;
              LDstScanArray[LXPos * PixelRectSize + LiiX].rgbRed      := LGridRValue;
              LDstScanArray[LXPos * PixelRectSize + LiiX].rgbGreen    := LGridGValue;
              LDstScanArray[LXPos * PixelRectSize + LiiX].rgbBlue     := LGridBValue;
            end else begin
              LDstScanArray[LXPos * PixelRectSize + LiiX].rgbReserved := LAValue;
              LDstScanArray[LXPos * PixelRectSize + LiiX].rgbRed      := LRValue;
              LDstScanArray[LXPos * PixelRectSize + LiiX].rgbGreen    := LGValue;
              LDstScanArray[LXPos * PixelRectSize + LiiX].rgbBlue     := LBValue;
            end;
          end;
        end;

        Inc(LpRGBQuad);
      end;
      Inc(LScanLine, LDataStride);
    end;

    //作成したTBitmapをTImageのCanvasに描画
    //AlphaFormat := afDefinedにして半透明画像のピクセルも半透明で表示する
    DrawTimage.Picture.Bitmap.SetSize(LImgWidth, LImgHeight);
    LImgBitmap.AlphaFormat := afDefined;
    DrawTimage.Canvas.Draw(0, 0, LImgBitmap);
  finally
    SrcGPBitmap.UnlockBits(LBmpData);
    LImgBitmap.Canvas.Unlock;

    FreeAndNil(LImgBitmap);
  end;
end;

//-----------------------------------------------------------------------------
//  読み込んだビットマップ(TBitmap)画像のアルファ値の処理
//
//  TGPBitmapはTBitmapのアルファチャンネルを処理しない
//  TBitmapのアルファ値をTGPBitmapのアルファ値に代入する
//  アルファチャンネル付きTBitmapをアルファチャンネル付きで表示可能にする
//  元のビット深さが32bit以上用
//-----------------------------------------------------------------------------
function TForm1.SetAlphaValueFromTBitmap(DstGPBitmap: TGPBitmap;
  SrcBitmap: TBitmap): Boolean;
type
  TRGBQArray = array [0..4095] of RGBQUAD;
  PRGBQArray = ^TRGBQArray;
var
  LImgWidth   : Integer;
  LImgHeight  : Integer;
  LBmpData    : TBitmapData;
  LScanLine   : PByte;
  LpRGBQuad   : PRGBQuad;
  LDataStride : Integer;
  LXPos       : integer;
  LYPos       : Integer;
  LScanArray  : PRGBQArray;
  LAValue     : Byte;
  LRValue     : Byte;
  LGValue     : Byte;
  LBValue     : Byte;
begin
  Result := False;

  LImgWidth  := DstGPBitmap.GetWidth;
  LImgHeight := DstGPBitmap.GetHeight;

  //TGPBitmapのビットマップデータ取得
  if DstGPBitmap.LockBits(MakeRect(0, 0, LImgWidth, LImgHeight), ImageLockModeWrite,
                                 PixelFormat32bppARGB, LBmpData) <> Ok then exit;

  SrcBitmap.Canvas.Lock;

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

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

    for LXPos := 0 to LImgWidth - 1 do begin

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

      if MakeColor(LRValue, LGValue, LBValue, LAValue) = 0 then begin
        LpRGBQuad^.rgbReserved := 0;
      end else
      if (LAValue = 0) then begin
        LpRGBQuad^.rgbReserved := $FF;
      end else begin
        LpRGBQuad^.rgbReserved := LScanArray[LXPos].rgbReserved;
      end;
      Inc(LpRGBQuad);
    end;
    Inc(LScanLine, LDataStride);
  end;

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

//-----------------------------------------------------------------------------
//  読み込んだPNG画像とGIF画像の透過ピクセルの処理
//
//  透過設定のピクセルを透明ピクセルにする
//  複数の色を透過設定しているPNG形式の画像を扱うための対策処理
//  この関数を実行するとどの色が透過色になっているかの情報は失われる
//
//  IsGIFFile引数をTrueにすると元のGIFファイルの透過色を表示する
//  ただし透過色としての指定は無効になっている
//
//  TransAlphaLevelはどの程度の透明度までを透明とするかの設定用
//  ex.1
//  $0F とするとARGB(0,0,0,0)からARGB($0F,0,0,0)までのピクセルを透明色にする
//  ex.2
//  透明色を持つ画像(多くの場合背景が透明色)をGIF形式の画像で保存したい場合
//  GIF画像には透明色はないので，透明色の部分をある色で塗り潰し，それを
//  透過色に設定することになる
//  この時，どの程度の透明度までを塗り潰すかによって結果のGIF画像の品質が変わる
//-----------------------------------------------------------------------------
function TForm1.SetAlphaZeroPixelsSelfTGPBitmap(TargetGDPBmp: TGPBitmap;
  TransAlphaLevel: Byte = 0; IsGIFFile: Boolean = False): Boolean;
var
  LImgWidth   : Integer;
  LImgHeight  : Integer;
  LBmpData    : TBitmapData;
  LScanLine   : PByte;
  LpRGBQuad   : PRGBQuad;
  LDataStride : Integer;
  LXPos       : integer;
  LYPos       : Integer;
  LAValue     : Byte;
  LRValue     : Byte;
  LGValue     : Byte;
  LBValue     : Byte;
  LTransCheck : Boolean;
begin
  Result := False;

  LImgWidth  := TargetGDPBmp.GetWidth;
  LImgHeight := TargetGDPBmp.GetHeight;

  //TGPBitmapのビットマップデータ取得
  if TargetGDPBmp.LockBits(MakeRect(0, 0, LImgWidth, LImgHeight), ImageLockModeWrite,
                        PixelFormat32bppARGB, LBmpData) <> Ok then exit;

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

  for LYPos := 0 to LImgHeight - 1 do begin
    LpRGBQuad := PRGBQuad(LScanLine);
    for LXPos := 0 to LImgWidth - 1 do begin

      LAValue := LpRGBQuad^.rgbReserved;
      LRValue := LpRGBQuad^.rgbRed;
      LGValue := LpRGBQuad^.rgbGreen;
      LBValue := LpRGBQuad^.rgbBlue;

      LTransCheck := (LAValue = 0) or
                     ((LAValue <= TransAlphaLevel)
                      and (LRValue = 0) and (LGValue = 0) and (LBValue = 0));

      if LTransCheck then begin
        if IsGIFFile then begin
          LpRGBQuad^.rgbReserved := $FF;
        end else begin
          LpRGBQuad^.rgbReserved := 0;
          LpRGBQuad^.rgbRed   := 0;
          LpRGBQuad^.rgbGreen := 0;
          LpRGBQuad^.rgbBlue  := 0;
        end;
      end;

      Inc(LpRGBQuad);
    end;
    Inc(LScanLine, LDataStride);
  end;
  TargetGDPBmp.UnlockBits(LBmpData);

  Result := True;
end;

//-----------------------------------------------------------------------------
//  指定した色のピクセルを別の色に変更する関数
//
//  GDI+にはTColorMapで色を変更できるがTColorMapはカラーマップの変更なので
//  画面上では指定した色でないピクセルの色が変更される場合がある
//-----------------------------------------------------------------------------
function TForm1.ChangeColor(TarGPBitmap: TGPBitmap; OldColor,
  NewColor: TGPColor): Boolean;
var
  LImgWidth   : Integer;
  LImgHeight  : Integer;
  LBmpData    : TBitmapData;
  LScanLine   : PByte;
  LpRGBQuad   : PRGBQuad;
  LDataStride : Integer;
  LXPos       : integer;
  LYPos       : Integer;
  LAValue     : Byte;
  LRValue     : Byte;
  LGValue     : Byte;
  LBValue     : Byte;
  LOldColor   : TGPColor;
begin
  Result := False;

  LImgWidth  := TarGPBitmap.GetWidth;
  LImgHeight := TarGPBitmap.GetHeight;

  //TGPBitmapのビットマップデータ取得
  if TarGPBitmap.LockBits(MakeRect(0, 0, LImgWidth, LImgHeight), ImageLockModeWrite,
                                 PixelFormat32bppARGB, LBmpData) <> Ok then exit;

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

  for LYPos := 0 to LImgHeight - 1 do begin
    LpRGBQuad  := PRGBQuad(LScanLine);

    for LXPos := 0 to LImgWidth - 1 do begin

      LAValue   := LpRGBQuad^.rgbReserved;
      LRValue   := LpRGBQuad^.rgbRed;
      LGValue   := LpRGBQuad^.rgbGreen;
      LBValue   := LpRGBQuad^.rgbBlue;
      LOldColor := MakeColor(LAValue, LRValue, LGValue, LBValue);

      if LOldColor = OldColor then begin
        LpRGBQuad^.rgbReserved := GetAlpha(NewColor);
        LpRGBQuad^.rgbRed      := GetRed(NewColor);
        LpRGBQuad^.rgbGreen    := GetGreen(NewColor);
        LpRGBQuad^.rgbBlue     := GetBlue(NewColor);
      end;
      Inc(LpRGBQuad);
    end;
    Inc(LScanLine, LDataStride);
  end;

  TarGPBitmap.UnlockBits(LBmpData);
  Result := True;
end;

end.


ピクセルの色の変更には以下のように GetPixel と SetPixel メソッ も使用できます．
一般的に ScanLine を使用した方がはるかに高速です．このサンプル程度のサンプルでは違いを確認することはできませんが，このような処理を連続して実行すると違いが確実に現れます．


リスト10
TGPBitmap の GetPixel と SetPixel メソッドを使用するピクセルの色の変更		 
function TForm1.ChangeColor(TarGPBitmap: TGPBitmap; OldColor,
  NewColor: TGPColor): Boolean;
var
  LImgWidth  : Integer;
  LImgHeight : Integer;
  LXPos      : integer;
  LYPos      : Integer;
  LOldColor  : TGPColor;
begin
  Result := False;

  LImgWidth  := TarGPBitmap.GetWidth;
  LImgHeight := TarGPBitmap.GetHeight;

  for LYPos := 0 to LImgHeight - 1 do begin
    for LXPos := 0 to LImgWidth - 1 do begin
      Result := TarGPBitmap.GetPixel(LXPos, LYPos, LOldColor) = Ok;
      if LOldColor = OldColor then begin
        TarGPBitmap.SetPixel(LXPos, LYPos, NewColor);
      end;
    end;
  end;
end;


ピクセルの色のグリッド表示ルーチンの中にグリッド線を描画するコードがあります．
グリッドの描画は独立して以下のようにも書けます．このコードは，ピクセルの色の描画終了後に実行します．



リスト11
グリッド線を独立して描画する場合の参考コード		 
  if ShowGridLine then begin
    DrawTimage.Canvas.Pen.Width := 1;
    DrawTimage.Canvas.Pen.Color := GridLineColor;
    for LXPos := 0 to LSrcImgWidth do begin
      DrawTimage.Canvas.MoveTo(LXPos * PixelRectSize, 0);
      DrawTimage.Canvas.LineTo(LXPos * PixelRectSize, LImgHeight);
    end;
    for LYPos := 0 to LSrcImgHeight do begin
      DrawTimage.Canvas.MoveTo(0, LYPos * PixelRectSize);
      DrawTimage.Canvas.LineTo(LImgWidth, LYPos * PixelRectSize);
    end;
  end;



09_透過状態確認用の背景画像を描画


実際の画像を描画する前に背景に特定の画像を描画すると，透明あるいは半透明の状態が確認できて便利なことがあります．
このような画像には一般的に格子状の市松模様の画像が使用されています．大きなサイズを用意する必要はありません．画像をテクスチャブラシ (TextureBrush) として描画します．以下はそのような背景画像を描画する例です．

GDI+ のハッチブラシには市松模様があります．それらも利用可能です．



[備考]
前項のサンプルは，背景画像を用意すれば背景画像を描画できるようになっています．



図24
設計時の画面
  • 描画用に TPaintBox を配置
図25
画像を読み込んで表示
  • 透過部分には背景画像が表示されている
図26
背景の画像を変更
  • 格子の間隔が狭い市松模様
図27
半透明のビットマップ画像の場合
  • 半透明であることが確認できる

リスト12
透過状態の確認のために背景に画像を描画する例		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
  private
    { Private 宣言 }
    FImageFilePath   : string;
    FBaxkImgFilePath : string;
    FGPBitmap        : TGPBitmap;
    FGPBackBitmap    : TGPBitmap;
    FDrawWidth       : Integer;
    FDrawHeight      : Integer;
    function SetAlphaValueFromTBitmap(DstGPBitmap: TGPBitmap;
      SrcBitmap: TBitmap): Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  このフォームのDoubleBufferedの値をオブジェクトインスペクタでTrueにしている
//  オブジェクトインスペクタでの設定と実行時の設定とでは動作が異なる場合がある
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'GDI+  透過状態確認用に背景に画像を描画';

  FImageFilePath   := '';
  FBaxkImgFilePath := '';

  SpinEdit1.Value := 0;
  SpinEdit2.Value := 0;
  CheckBox1.Checked := True;

  FBaxkImgFilePath := ExpandFileName('.\TestImages\backTexture_01.gif');
  OpenPictureDialog1.InitialDir := ExpandFileName('.\TestImages');
end;

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

//=============================================================================
//  画像の読み込みボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap : TBitmap;
begin
  OpenPictureDialog1.Filter     := '画像ファイル|*.png;*.jpg;*.bmp;*.gif;*.ico';
  if OpenPictureDialog1.Execute then begin
    if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);
    if Assigned(FGPBackBitmap) then FreeAndNil(FGPBackBitmap);

    FImageFilePath := OpenPictureDialog1.FileName;
    OpenPictureDialog1.InitialDir := ExtractFileDir(FImageFilePath);

    //画像ファイルからTGPImageのオブジェクトを生成
    FGPBitmap := TGPBitmap.Create(FImageFilePath);

    //ビットマップ画像の場合はアルファチャンネル処理
    LBitmap := TBitmap.Create;
    try
      try
        LBitmap.LoadFromFile(FImageFilePath);
        if LBitmap.PixelFormat = pf32bit then begin
          SetAlphaValueFromTBitmap(FGPBitmap, LBitmap);
        end;
      except
      end;
    finally
      FreeAndNil(LBitmap);
    end;

    //表示サイズの設定等をして描画
    CheckBox2Click(nil);
    SpinEdit1.Value :=FGPBitmap.GetWidth;
  end;
end;

//=============================================================================
//  SpinEdit1のOnChangeイベント処理
//  TImageの幅(画像の表示幅)を設定
//  SpinEdit2(TImageの高さ)はReadOnlyにしている
//=============================================================================
procedure TForm1.SpinEdit1Change(Sender: TObject);
var
  LRatio        : Double;
  LOriginWidth  : Integer;
  LOriginHeight : Integer;
begin
  if not Assigned(FGPBitmap) then exit;

  //画像のサイズを取得
  LOriginWidth  := FGPBitmap.GetWidth;
  LOriginHeight := FGPBitmap.GetHeight;
  //縦横比を計算
  LRatio := LOriginHeight / LOriginWidth;

  //描画のサイズを計算
  FDrawWidth  := SpinEdit1.Value;
  FDrawHeight := Trunc(LRatio * FDrawWidth);
  SpinEdit2.Value := FDrawHeight;

  PaintBox1.Invalidate;
end;

//=============================================================================
//  CheckBox1,CheckBox2共有のOnClick2Clickイベント処理
//  背景画像表示の有無と画像の種類の設定
//=============================================================================
procedure TForm1.CheckBox2Click(Sender: TObject);
begin
  if Assigned(FalseBoolStrs) then FreeAndNil(FGPBackBitmap);

  if CheckBox2.Checked then begin
    FBaxkImgFilePath := ExpandFileName('.\TestImages\backTexture_02.gif')
  end else begin
    FBaxkImgFilePath := ExpandFileName('.\TestImages\backTexture_01.gif')
  end;
  FGPBackBitmap := TGPBitmap.Create(FBaxkImgFilePath);
  PaintBox1.Invalidate;
end;

//=============================================================================
//  PaintBox1のOnPaintイベント処理
//  実際の描画コード
//=============================================================================
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  LGPGraphic : TGPGraphics;
  LGPBrush   : TGPTextureBrush;
begin
  inherited;
  if not Assigned(FGPBitmap) then exit;

  //TGPGraphicsのオブジェクトを生成
  //描画先はこのTPaintBox
  LGPGraphic := TGPGraphics.Create(PaintBox1.Canvas.Handle);

  //透明部分の透過様態を表示するための背景画像を描画
  if CheckBox1.Checked then begin
    if Assigned(FGPBackBitmap) then begin
      LGPBrush := TGPTextureBrush.Create(FGPBackBitmap);
      try
        LGPGraphic.FillRectangle(LGPBrush, MakeRect(0, 0, FDrawWidth, FDrawHeight));
      finally
        FreeAndNil(LGPBrush);
      end;
    end;
  end;

  //FGPBitmapをCanvasに描画
  LGPGraphic.DrawImage(
              FGPBitmap,
              MakeRect(0, 0, FDrawWidth, fDrawHeight),
              0,
              0,
              FGPBitmap.GetWidth,
              FGPBitmap.GetHeight,
              UnitPixel);

  //Createしたオブジェクトは解放処理する
  FreeAndNil(LGPGraphic);
end;

//-----------------------------------------------------------------------------
//  読み込んだビットマップ(TBitmap)画像のアルファ値の処理
//
//  TGPBitmapはTBitmapのアルファチャンネルを処理しない
//  TBitmapのアルファ値をTGPBitmapのアルファ値に代入する
//  アルファチャンネル付きTBitmapをアルファチャンネル付きで表示可能にする
//  元のビット深さが32bit以上用
//-----------------------------------------------------------------------------
function TForm1.SetAlphaValueFromTBitmap(DstGPBitmap: TGPBitmap;
  SrcBitmap: TBitmap): 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;

  LWidth  := DstGPBitmap.GetWidth;
  LHeight := DstGPBitmap.GetHeight;

  //TGPBitmapのビットマップデータ取得
  if DstGPBitmap.LockBits(MakeRect(0, 0, LWidth, LHeight), ImageLockModeWrite,
                                 PixelFormat32bppARGB, LBmpData) <> Ok then exit;

  SrcBitmap.Canvas.Lock;

  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 MakeColor(LRValue, LGValue, LBValue, LAValue) = 0 then begin
        LpRGBQuad^.rgbReserved :=  0;
      end else
      if (LAValue = 0) then begin
        LpRGBQuad^.rgbReserved := $FF;
      end else begin
        LpRGBQuad^.rgbReserved := LScanArray[LXPos].rgbReserved;
      end;
      Inc(LpRGBQuad);
    end;
    Inc(LScanLine, LDataStride);
  end;

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

end.



10_GDI+ における拡大・縮小時のスムージング処理


GDI+ では画像や図形の描画の際，ある程度のスムージング処理，つまり，アンチエイリアスの処理を行ってくれます．
下図は，これまでのテストでも使用してきた添付のビットマップ画像のファイルを表示しています．このビットマップ画像の元のサイズは (100 x 101) ピクセルです．最初の図は，TImage へ描画のサンプルで表示して横幅を 500 ピクセルに拡大しています．その下の図は，TCanvas.StretchDraw メソッドで TImage に描画した結果です．
TCanvas.StretchDraw メソッド，つまり GDI で描画した結果はギザギザが目立っています．GDI+ で描画した結果は，アンチエイリアスの処理によって滑らかに描画されているのが確認できます．


図28
GDI+ による描画
  • 元のサイズは (100 x 101)
図29
GDI による描画
  • 元のサイズは (100 x 101)
  • ギザギザが目立つ

上の図は拡大の場合でした．下図は縮小の例です．
Delphi 10.1 Berlin Stater の IDE をキャプチャしたビットマップ画像を読み込んで描画した画像です．元のサイズは (1464 x 1148) ですが，それを横幅を 800 ピクセルにして，縦横比を保ったまま縮小表示しています．文字は小さくなりますが，GDI+ では判別できます．一方の GDI による描画では文字の判別が困難な状態になっています．



図30
GDI+ による描画
  • (1464 x 1148) を (800 x 627) に縮小表示した結果
図31
GDI による描画
  • TCanvas.StretchDraw メソッドによる描画．つまり GDI による描画ということになる
  • (1464 x 1148) を (800 x 627) に縮小表示した結果

ウェブブラウザで拡大表示してみると違いがより明確に分かります．
[Ctrl] + [+] キー操作で拡大表示できます．[Ctrl] + [0] で元の表示に戻ります．縮小は [Ctrl] + [-] です．IE で拡大表示すると，当サイトの右ペインの記事が横にスクロールします．水平スロールバーでスクロールしないと記事本文が見えなくなる場合があります．

リスト13
TImage.Canvas.StretchDraw メソッドによる画像の描画と保存
機能は TImage への描画のサンプルと同じ		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Image1: TImage;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
  private
    { Private 宣言 }
    FPicture : TPicture;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'GDI  TImage に画像を描画';

  SpinEdit1.Value := Image1.Width;
  SpinEdit2.Value := Image1.Height;

  OpenPictureDialog1.InitialDir := ExpandFileName('..\');
  OpenPictureDialog1.FileName   :=  '501.bmp';
end;

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

//=============================================================================
//  画像の読み込みボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFileName   : string;
  LFileStream : TMemoryStream;
begin
  if Assigned(FPicture) then FreeAndNil(FPicture);

  if OpenPictureDialog1.Execute then begin
    LFileName := OpenPictureDialog1.FileName;
    OpenPictureDialog1.InitialDir := ExtractFileDir(LFileName);

    LFileStream := TMemoryStream.Create;
    try
      FPicture := TPicture.Create;
      FPicture.LoadFromFile(LFileName);

      //読み込んだ画像がビットマップの場合はアルファチャンネルでの描画を有効に
      if FPicture.Graphic is TBitmap then begin
        //Delphi 2009以降
        FPicture.Bitmap.AlphaFormat := afDefined;
      end;

      //描画サイズはTSpinEditの値に従う
      SpinEdit1Change(nil);
    finally
      FreeAndNil(LFileStream);
    end;
  end;
end;

//=============================================================================
//  保存ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LSaveFileName : string;
begin
  if not Assigned(FPicture) then exit;

  LSaveFileName := ExpandFileName('..\Save.bmp');
  Image1.Picture.SaveToFile(LSaveFileName);
end;

//=============================================================================
//  SpinEdit1のOnChangeイベント処理
//  TImageの幅(画像の表示幅)を設定
//  SpinEdit2(TImageの高さ)はReadOnlyにしている
//=============================================================================
procedure TForm1.SpinEdit1Change(Sender: TObject);
var
  LRatio : Double;
begin
  if not Assigned(FPicture) then exit;
  if FPicture.Width <= 0 then exit;

  Image1.Picture.Assign(nil);

  //縦横比を計算
  //縦横比を維持して描画する
  LRatio := FPicture.Height / FPicture.Width;
  Image1.Width  := SpinEdit1.Value;
  Image1.Height := Trunc(LRatio * Image1.Width);
  SpinEdit2.Value := Image1.Height;

  Image1.Stretch := True;
  //Assignによる代入ではTImageを拡大縮小しても元の画像サイズのまま
  Image1.Canvas.StretchDraw(Image1.ClientRect, FPicture.Graphic);
end;

end.



11_TGPImage ( TGPBitmap ) と TBitmap の相互変換


描画先の Canvas を TBitmap の Canvas にすれば，その TBitmap に TGPImage (TGPBitmap) の内容が格納されます．この時，サイズを指定して描画すれば，拡大あるいは縮小して描画できます．本ページのサンプルでは保存の時にこの方法を使用しています．

TBitmap の情報を TGPImage または TGPBitmap に格納するには，TMemoryStream や TFileStream 等のメモリストリームを使用します．メモリストリームから直接読み込めないので，TStreamAdapter を使用します．本ページのサンプルでは画像ファイルの読み込みの際にこの方法を使用しています．

TGPBitmap は TGPImage に機能を追加したクラスです．ビットマップを扱うためのプロパティやメソッド類が TGPImage に追加されています．





12_TBitmap と TGPBitmap の同サイズで相互変換


TBitmap からは TGPBitmap の Create メソッドで TGPBitmap が生成できます．生成するサイズは指定できません．また，TGPBitmap の GetHBITMAP メソッドを使用すると TGPBitmap から TBitmap が取得できます．GetHBITMAP も取得するサイズの指定はできません．



[備考]
GetHBITMAP メソッドは，アルファチャンネル付きの画像の場合，ビットマップ画像として正常に取得できない場合があります．TGPBitmap の Save メソッドでビットマップの画像ファイルとして保存して，その画像ファイルから取得する方が確実です．
(2017年09月07日 追記)



図32
[Button1] で TBitmap から TGPBitmap 作成
  • [Button2] で TGPBitmap から TBitmap を取得して保存
  • 表示は拡大した画像だが，保存サイズは元の TGPBitmap のサイズとなる

リスト14
TBitmap から TGPBitmap の生成と TGPBitmap から TBitmap を取得する例		 
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

//=============================================================================
//  TBitmapからTGPbitmapを生成
//
//  [参考]
//  TGPBitmap.FromHBITMAPは現在のTGPBitmapから別のTGPBitmapを生成するメソッド
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap   : TBitmap;
  LhBitmap  : HBITMAP;
  LhPaletTe : HPALETTE;
begin
  if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);

  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile(ExpandFileName('..\501.bmp'));

    LhBitmap  := LBitmap.Handle;
    LhPaletTe := LBitmap.Palette;

    FGPBitmap := TGPBitmap.Create(LhBitmap, LhPaletTe);

    Invalidate;
  finally
    FreeAndNil(LBitmap);
  end;

  DeleteObject(LhPaletTe);
  DeleteObject(LhBitmap);
end;

//=============================================================================
//  TGPBitmapからTBitmapを取得
//  取得サイズは表示サイズではなく元のTGPBitmapのサイズ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LBitmap  : TBitmap;
  LhBitmap : HBITMAP;
begin
  if not Assigned(FGPBitmap) then exit;

  LBitmap := TBitmap.Create;
  try
    FGPBitmap.GetHBITMAP(0, LhBitmap);
    LBitmap.Handle := LhBitmap;

    LBitmap.SaveToFile('000.bmp');
  finally
    //TBitampにHBITMAPを代入した場合はオブジェクトの削除は不要
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  描画コード
//=============================================================================
procedure TForm1.FormPaint(Sender: TObject);
var
  LGPGraphic : TGPGraphics;
begin
  inherited;
  if not Assigned(FGPBitmap) then exit;

  //TGPGraphicsのオブジェクトを生成
  //描画先はこのTMyPanelのTCanvas
  LGPGraphic := TGPGraphics.Create(Canvas.Handle);

  //TGPImageを描画(元の2倍のサイズで)
  LGPGraphic.DrawImage(FGPBitmap, 50, 50,
                                  FGPBitmap.GetWidth * 2, FGPBitmap.GetHeight * 2);

  //Createしたオブジェクトは解放処理する
  LGPGraphic.Free;
end;

end.