Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2023年01月03日] [更新 2023年01月03日]　Delphi サンプルプログラム集
   
088_TBitmap の画像を TImage に描画
動作確認等 Windows 10 ビルド 19043 Pro 64 bit + Delphi XE5(UP2) Pro VCL-32
088_Bitmap_DrawToTImage.zip　[3,6 MB]　2023年01月03日版 (EXE 同梱)






TBitmap の画像を TImage に描画


主に TBitmap の画像を TImage に描画するサンプルです．
サンプルプログラム集には，処理の結果として TBitmap の画像を TImage に描画するサンプルはありますが，本ページは，単純にファイルから読み出した TBitmap の画像を表示するたけのサンプルとしています．


[備考]
TBitmap の TransparentColor も Transparent プロパティも public なプロパティです．実行時にこれらの値を設定して TBitmap の画像を保存しても，これらの値は保存されません．
TransparentColor のデフォルト値は TBitmap.Canvas の左下のピクセルの色となります．Transparent プロパティのデフォルト値は False です．
TBitmap の AlphaFormat も public なプロパティです．デフォルトは afIgnored です．




01_アルファ値を使用する 32 ビットの TBitmap を TImage に描画


Delphi の TBitmap 画像の色深度はデフォルトで 32 ビットです．32 ビットの TBitmap は，各ピクセルの不透明度を指定する 1 バイトのアルファ値を格納するデータ領域を持っていますが，デフォルトではこのデータを使用しません．アルファ値を使用した描画を行うには，AlphaFormat プロパティの値を afDefined にします．AlphaFormat プロパティは public なプロパティです．

本サンプルでは，アルファ値のデータが 0 でないビットマップを読み込んで，TImage に描画します．これは，アルファ値を使用するビットマップということになります．

下図は AlphaFormat プロパティの値を afDefined の場合です．背景の市松模様が見えているピクセルは，A, R, G, B の値が全て 0 のピクセルです．ここれは透明色です．透明色のピクセルが透過状態になります．半透明の色を透過職にすることはできません．
A はアルファ値を意味します．



図1
AlphaFormat が afDefined の場合

AlphaFormat プロパティの値を指定しない場合です．
AlphaFormat プロパティの値を指定しない場合は，AlphaFormat プロパティの値を afIgnored にした場合と同じになり，アルファ値を使用しないで描画します．透明色のピクセルの R, G, B の値は 0 です．アルファ値を使用しないので「黒」になります．

これは，24 ビット以下のビットマップ画像ファイルを TBitmap に読み込んだ時と同じです．24 ビット以下のビットマップを読み込んだ時は，TBitmap のビット深さは，そのビットマップのビット深さと同じになります．24 ビット以下のビットマップにはアルファチャンネルはありません．



図2
AlphaFormat を指定しない場合
  • AlphaFormat が afIgnored の時と同じになる
  • afIgnored はデフォルトの値

同じく，AlphaFormat プロパティの値を指定しない場合ですが，Transparent プロパティの値を True にした場合です．
Transparent が True の時，デフォルトでは画像の左下のピクセルの色が透過色になります．AlphaFormat を指定していないのでアルファ値は無効ですから，左下のピクセルの色は「黒」です．したがって，画像の黒のピクセルが透過状態になります．下図で黒く見えるピクセルは，元は半透明のピクセルです．実際には黒ではなく，黒に近い色です．R, G, B の値が 0 に近い色です．



図3
AlphaFormat を指定しないで，Transparent を True にした場合

リスト1
アルファ値を使用する 32 ビットの TBitmap を TImage に描画		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure BmpDrawTo(ABitmap: TBitmap; AImage: TImage);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  FImgFilePath : string = '..\Images\images_32bit.bmp';

//=============================================================================
//  アルファチャンネル付きの 32 ビットのビットマップを TImage に描画
//  TBitmap.AlphaFormat := afDefined にすればよい
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap  : TBitmap;
begin
  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile(FImgFilePath);

    LBitmap.AlphaFormat := afDefined;
    BmpDrawTo(LBitmap, Image1);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  アルファチャンネル付きの 32 ビットのビットマップを TImage に描画
//  TBitmap.AlphaFormat の値を指定しない場合
//  TBitmap.AlphaFormat := afIgnored ( デフォルト ) と同じ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LBitmap  : TBitmap;
begin
  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile(FImgFilePath);

    BmpDrawTo(LBitmap, Image1);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  アルファチャンネル付きの 32 ビットのビットマップを TImage に描画
//  TBitmap.Transparent := True にした場合
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LBitmap  : TBitmap;
begin
  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile(FImgFilePath);

    LBitmap.Transparent := True;
    BmpDrawTo(LBitmap, Image1);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//-----------------------------------------------------------------------------
//  引数のビットマップを TImage に描画
//  透過状態確認用に，背景を市松模様のビットマップにする
//-----------------------------------------------------------------------------
procedure TForm1.BmpDrawTo(ABitmap: TBitmap; AImage: TImage);
var
  LBitmap : TBitmap;
begin
  AImage.Picture.Assign(nil);

  // TImage32 の背景を市松模様のタイルにする
  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile('..\Images\backTexture_02.bmp');

    AImage.Canvas.Brush.Style  := bsSolid;
    AImage.Canvas.Brush.Bitmap := LBitmap;
    AImage.Canvas.FillRect(AImage.Canvas.ClipRect);
  finally
    FreeAndNil(LBitmap);
  end;

  // ビットマップ画像を描画
  AImage.Canvas.Draw(0, 0, ABitmap);
end;
end.


[備考]
32 ビットの，アルファ値が 0 でないビットマップの PixelFormat プロパティの値を pf24bit にした場合，減色処理が行われます．その結果，半透明のピクセルは異なる色になります．
例えば，本項で使用したビットマップ画像の場合，半透明のピクセルは黒に近い色になります．




02_アルファ値を使用しない 32 ビットの TBitmap を TImage に描画


前項と同じで，32 ビットのビットマップを読み込み，TImage に描画しますが，このビットマップは，アルファ値が全て 0 のビットマップです．
24 ビット以下のビットマップの  PixelFormat プロパティの値を pf32bit にすると，アルファ値を使用しないビットマップとなります．

下図は，32 ビットのビットマップ画像ファイルを読み込んで，そのまま IImage に描画した結果です．サンプルコードでは ，AlphaFormat プロパティの値を afIgnored にしていますが，これはデフォルト値なので設定しなくても結果は同じです．



図4
TBitmap に，ビットマップ画像ファイルを読み込んで描画

Transparent プロパティの値を True にした場合です．
Transparent を True にすると，デフォルトでは画像の左下のピクセルの色が透過色になります．本サンプルで使用した画像では枠線の色です．



図5
Transparent を True にした場合

同じく，Transparent プロパティの値を True にする例ですが，透過色を TransparentColor プロパティで指定した結果です．透過色は，枠線内の色にしています．



図6
Transparent を True にした場合
  • 透過色は枠線内部の色
  • 透過色は TransparentColor で設定

下図は AlphaFormat プロパティの値を afDefined にした場合です．透明な画像になります．
本サンプルで使用している TBitmap の画像は，アルファ値が全て 0 です．全てのピクセルで R, G, B の値は 0 ではありません．しかし，AlphaFormat を afDefined にすると，アルファ値を使用して描画します．アルファ値が 0 ということは，不透明度が 0 ということです．つまり，透明ということです．



図7
AlphaFormat を afDefined にした場合
  • 全てのピクセルが透明な画像になる

リスト2
アルファ値を使用しない 32 ビットの TBitmap を TImage に描画		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure BmpDrawTo(ABitmap: TBitmap; AImage: TImage);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  FImgFilePath : string = '..\Images\Frame_32bit.bmp';

//=============================================================================
//  アルファチャンネルを使用しない 32 ビットのビットマップを TImage に描画
//  TBitmap.AlphaFormat := afIgnored ( デフォルト ) にすればよい
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap  : TBitmap;
begin
  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile(FImgFilePath);

    LBitmap.AlphaFormat := afIgnored;
    BmpDrawTo(LBitmap, Image1);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  アルファチャンネルを使用しない 32 ビットのビットマップを TImage に描画
//  TBitmap.Transparent := True にした場合
//  透過色は左下のピクセルの色になる
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LBitmap  : TBitmap;
begin
  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile(FImgFilePath);

    LBitmap.Transparent := True;
    BmpDrawTo(LBitmap, Image1);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  アルファチャンネルを使用しない 32 ビットのビットマップを TImage に描画
//  透過色を指定して，TBitmap.Transparent := True にした場合
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LBitmap  : TBitmap;
begin
  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile(FImgFilePath);

    LBitmap.TransparentColor := LBitmap.Canvas.Pixels[5, 5];
    LBitmap.Transparent := True;
    BmpDrawTo(LBitmap, Image1);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  アルファチャンネルを使用しない 32 ビットのビットマップを TImage に描画
//  TBitmap.AlphaFormat := afDefined ( アルファ値を使用) にした場合
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
  LBitmap  : TBitmap;
begin
  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile(FImgFilePath);

    LBitmap.AlphaFormat := afDefined;
    BmpDrawTo(LBitmap, Image1);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//-----------------------------------------------------------------------------
//  引数のビットマップを TImage に描画
//  透過状態確認用に，背景を市松模様のビットマップにする
//-----------------------------------------------------------------------------
procedure TForm1.BmpDrawTo(ABitmap: TBitmap; AImage: TImage);
var
  LBitmap : TBitmap;
begin
  AImage.Picture.Assign(nil);

  // TImage の背景を市松模様のタイルにする
  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile('..\Images\backTexture_02.bmp');

    AImage.Canvas.Brush.Style  := bsSolid;
    AImage.Canvas.Brush.Bitmap := LBitmap;
    AImage.Canvas.FillRect(AImage.Canvas.ClipRect);
  finally
    FreeAndNil(LBitmap);
  end;

  // ビットマップ画像を描画
  AImage.Canvas.Draw(0, 0, ABitmap);
end;
end.



03_24 ビット以下の TBitmap 画像を TImage に描画


24 ビット以下のビットマップ画像のファイルを読み込んで TImage に描画する場合です．
24 ビット以下の TBitmap にはアルファチャンネルはありません．ピクセルの色は R, G, B の 3 バイトの値で決まります．

下図は，TBitmap に，24 ビットのビットマップ画像を読み込んで TImage に描画した結果です．



図8
24 ビットのビットマップ画像

Transparent プロパティの値を True にした場合です．
Transparent を True にすると，デフォルトでは画像の左下のピクセルの色が透過色になり，透過状態になります．



図9
24 ビットのビットマップ画像
  • Transparent を True にした場合

同じく，Transparent プロパティの値を True にする例ですが，透過色を TransparentColor プロパティで指定した結果です．透過色は，画像左上の四角形のピクセルの色にしています．この色は黒です．



図10
24 ビットのビットマップ画像
  • TransparentColor の値を黒にして
  • Transparent を True にした場合

AlphaFormat プロパティの値を afDefined にした場合です．24 ビット以下の TBitmap では，AlphaFormat を設定しても無効です．AlphaFormat プロパティは，32 ビットの TBitmap 用のプロパティです．



図11
24 ビットのビットマップ画像
  • AlphaFormat の設定は無効

リスト3
24 ビット以下の TBitmap 画像を TImage に描画		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure BmpDrawTo(ABitmap: TBitmap; AImage: TImage);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  FImgFilePath : string = '..\Images\simple_24bit.bmp';

//=============================================================================
//  24 ビット以下のビットマップを TImage に描画
//  24 ビット以のビットマップにはアルファチャンネルがない
//  TBitmap.AlphaFormat := afIgnored ( デフォルト ) にすればよい
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap  : TBitmap;
begin
  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile(FImgFilePath);

    LBitmap.AlphaFormat := afIgnored;
    BmpDrawTo(LBitmap, Image1);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  24 ビット以下のビットマップを TImage に描画
//  24 ビット以のビットマップにはアルファチャンネルがない
//  TBitmap.Transparent := True にした場合
//  透過色は左下のピクセルの色になる
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LBitmap  : TBitmap;
begin
  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile(FImgFilePath);

    LBitmap.Transparent := True;
    BmpDrawTo(LBitmap, Image1);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  24 ビット以下のビットマップを TImage に描画
//  24 ビット以のビットマップにはアルファチャンネルがない
//  透過色を指定して，TBitmap.Transparent := True にした場合
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LBitmap  : TBitmap;
begin
  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile(FImgFilePath);

    LBitmap.TransparentColor := LBitmap.Canvas.Pixels[5, 5];
    LBitmap.Transparent := True;
    BmpDrawTo(LBitmap, Image1);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  24 ビット以下のビットマップを TImage に描画
//  24 ビット以のビットマップにはアルファチャンネルがないので
//  TBitmap.AlphaFormat の値は描画に関係ない
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
  LBitmap  : TBitmap;
begin
  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile(FImgFilePath);

    LBitmap.AlphaFormat := afDefined;
    BmpDrawTo(LBitmap, Image1);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//-----------------------------------------------------------------------------
//  引数のビットマップを TImage に描画
//  透過状態確認用に，背景を市松模様のビットマップにする
//-----------------------------------------------------------------------------
procedure TForm1.BmpDrawTo(ABitmap: TBitmap; AImage: TImage);
var
  LBitmap : TBitmap;
begin
  AImage.Picture.Assign(nil);

  // TImage の背景を市松模様のタイルにする
  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile('..\Images\backTexture_02.bmp');

    AImage.Canvas.Brush.Style  := bsSolid;
    AImage.Canvas.Brush.Bitmap := LBitmap;
    AImage.Canvas.FillRect(AImage.Canvas.ClipRect);
  finally
    FreeAndNil(LBitmap);
  end;

  // ビットマップ画像を描画
  AImage.Canvas.Draw(0, 0, ABitmap);
end;

end.



04_フォルダ内の BMP / PNG / GIF / ICO 画像を TImage に連続描画


添付の [Images] フォルダ内には，テスト用の画像があります．その [Imagaes] フォルタ内の画像ファイルを，順番に読み出して表示するサンプルです．
画像は，TImage の左右上下の中央に描画するようにしています．



図12
フォルダ内の画像を順番に表示

リスト4
フォルダ内の BMP / PNG / GIF / ICO 画像を順番に，TImage に描画		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    SpeedButton2: TSpeedButton;
    SpeedButton1: TSpeedButton;
    Image1: TImage;
    Edit1: TEdit;
    CheckBox1: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private 宣言 }
    FFileDir  : string;
    FFileList : TStringList;
    procedure DrawBackGouundBmp(AImage: TImage; AWidth, AHeight: Integer);
  public
    { Public 宣言 }
  end;

  function BmpIsUsedAlphaValue(ABitmap: TBitmap): Boolean;

var
  Form1: TForm1;

implementation

uses
  System.Types,
  System.IOUtils,
  System.StrUtils,
  Vcl.Imaging.pngimage,
  Vcl.Imaging.GIFImg;

{$R *.dfm}

const
 FExtArray : array [0..3] of string = ('.bmp', '.png', '.gif', '.ico');

//=============================================================================
//  フォーム生成時の処理
//  指定ディレクトリ内の指定拡張子のファイルのリストを作成
//
//  uses に System.Types,System.IOUtils が必要
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LFileArray : TStringDynArray;
  LFileExe   : string;
  LIndex     : Integer;
begin
  CheckBox1.Caption := 'ビットマップの透過色を使用する透過処理';

  FFileDir := '..\Images\';
  LFileArray := TDirectory.GetFiles(FFileDir, '*.*');

  FFileList := TStringList.Create;
  for LIndex := 0 to Length(LFileArray) - 1 do begin
    LFileExe := ExtractFileExt(LFileArray[LIndex]);
    if MatchText(LFileExe, FExtArray) then begin
      FFileList.Add(LFileArray[LIndex]);
    end;
  end;

  SpeedButton2Click(SpeedButton2);
end;

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

//=============================================================================
//  前の画像ファイルを読み込んで表示
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  SpeedButton2Click(SpeedButton1);
end;

//=============================================================================
//  次の画像ファイルを読み込んで表示
//  uses に System.IOUtils, Vcl.Imaging.pngimage, Vcl.Imaging.GIFImg が必要
//=============================================================================
procedure TForm1.SpeedButton2Click(Sender: TObject);
{$WRITEABLECONST ON}
const
  LIndex : Integer = -1;
{$WRITEABLECONST OFF}
var
  LImgPath : string;
  LFileExt : string;
  LBitmap  : TBitmap;
  LPngImg  : TPngImage;
  LGifImg  : TGIFImage;
  LIcon    : TIcon;
begin
  if Sender = SpeedButton2 then begin
    Inc(LIndex);
  end else
  if Sender = SpeedButton1 then begin
    Dec(LIndex);
  end;

  if (LIndex + 1) > FFileList.Count then begin
    LIndex := FFileList.Count - 1;
    Exit;
  end;
  if LIndex < 0 then begin
    LIndex := 0;
    Exit;
  end;


  while True do begin
    LImgPath := FFileList[LIndex];
    if FileExists(LImgPath) then Break;
    FFileList.Delete(LIndex);
    if (LIndex + 1) > FFileList.Count then Exit;
  end;

  SpeedButton1.Enabled := (LIndex > 0) and (FFileList.Count >= 2);
  SpeedButton2.Enabled := ((LIndex + 1) < FFileList.Count) and (FFileList.Count >= 2);


  LFileExt := LowerCase(ExtractFileExt(LImgPath));
  Edit1.Text := ExtractFileName(LImgPath);


  // [前] [次] の機能を正常に動作させるには，
  // FExtArray ( 拡張子名の配列) にある拡張子のファイルは全て処理する

  // ビットマップ画像ファイルの場合
  if LFileExt = '.bmp' then begin
    LBitmap := TBitmap.Create;
    try
      LBitmap.LoadFromFile(LImgPath);
      if not BmpIsUsedAlphaValue(LBitmap) then begin
        if CheckBox1.Checked then begin
          LBitmap.TransparentColor := LBitmap.Canvas.Pixels[0, LBitmap.Height - 1];
          LBitmap.Transparent := True;
        end;
      end;
      DrawBackGouundBmp(Image1, LBitmap.Width, LBitmap.Height);
      Image1.Canvas.Draw(0, 0, LBitmap);
    finally
      FreeAndNil(LBitmap);
    end;
  end else

  // PNG 画像ファイルの場合
  if LFileExt = '.png' then begin
    LPngImg := TPngImage.Create;
    try
      LPngImg.LoadFromFile(LImgPath);
      DrawBackGouundBmp(Image1, LPngImg.Width, LPngImg.Height);
      Image1.Canvas.Draw(0, 0, LPngImg);
    finally
      FreeAndNil(LPngImg);
    end;
  end else

// GIF 画像ファイルの場合
  if LFileExt = '.gif' then begin
    LGifImg := TGIFImage.Create;
    try
      LGifImg.LoadFromFile(LImgPath);
      DrawBackGouundBmp(Image1, LGifImg.Width, LGifImg.Height);
      Image1.Canvas.Draw(0, 0, LGifImg);
    finally
      FreeAndNil(LGifImg);
    end;
  end else

  // ICO 画像ファイルの場合
  // TIcon 画像は TBitmap に変換
  // 32 ビットの TIcon であればそのまま TImage に描画可能
  if LFileExt = '.ico' then begin
    LBitmap := TBitmap.Create;
    LIcon   := TIcon.Create;
    try
      LIcon.LoadFromFile(LImgPath);
      LBitmap.Assign(LIcon);
      DrawBackGouundBmp(Image1, LBitmap.Width, LBitmap.Height);
      Image1.Canvas.Draw(0, 0, LBitmap);
    finally
      FreeAndNil(LBitmap);
      FreeAndNil(LIcon);
    end;
  end;
end;

//=============================================================================
//  CheckBox1 をクリックしたら再描画
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  SpeedButton2Click(nil);
end;

//-----------------------------------------------------------------------------
//  画像の描画領域の背景を市松模様のビットマップ画像にする
//  透過状態の確認用
//  描画位置は TImage の中央
//-----------------------------------------------------------------------------
procedure TForm1.DrawBackGouundBmp(AImage: TImage; AWidth, AHeight: Integer);
var
  LBitmap : TBitmap;
begin
  AImage.Picture.Assign(nil);
  AImage.Picture.Bitmap.SetSize(AWidth, AHeight);
  AImage.Center := True;

  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile(FFileDir + 'backTexture_02.bmp');

    AImage.Canvas.Brush.Style  := bsSolid;
    AImage.Canvas.Brush.Bitmap := LBitmap;
    AImage.Canvas.FillRect(AImage.Canvas.ClipRect);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//-----------------------------------------------------------------------------
//  アルファチャンネル付きのビットマップかを判定
//  アルファチャンネル付きは，描画にアルファを使用していること
//
//  戻り値
//
//  True :  アルファチャンネルを使用する 32 ビットのビットマップ
//          引数の TBitmap.AlphaFormat の値を afDefined にして返す
//
//  False : アルファチャンネルを使用しない 32 ビットのビットマップ
//          引数の TBitmap.AlphaFormat の値を afIgnored にして返す
//          24 ビット以下の時も戻り値も False
//
//  透過ピクセルが透明色の場合，
//  TBitmap.TransparentColor の値が $02000000 であるかで判定できるが，
//  判定する前に TransParentColor の値を設定してしまうと区別できない
//-----------------------------------------------------------------------------
function BmpIsUsedAlphaValue(ABitmap: TBitmap): Boolean;
type
  TRGBQArray = array [0..4095] of RGBQUAD;
  PRGBQArray = ^TRGBQArray;
var
  LXPos      : integer;
  LYPos      : Integer;
  LBmpScan 　: PRGBQArray;
  LPixelCnt : Integer;
begin
  Result := False;
  if ABitmap.PixelFormat <> pf32bit then Exit;


  ABitmap.Canvas.Lock;
  try
    ABitmap.AlphaFormat := afIgnored;

    LPixelCnt := 0;
    for LYPos := 0 to ABitmap.Height - 1 do begin
      LBmpScan := ABitmap.ScanLine[LYPos];
      for LXPos := 0 to ABitmap.Width - 1 do begin
        if (LBmpScan[LXPos].rgbReserved = 0) then Inc(LPixelCnt);
      end;
    end;
    Result := LPixelCnt <> (ABitmap.Width * ABitmap.Height);

    if Result then begin
      ABitmap.AlphaFormat := afDefined;
    end else begin
      ABitmap.AlphaFormat := afIgnored;
    end;
  finally
    ABitmap.Canvas.Unlock;
  end;
end;

end.


アルファチャンネル付きの TBitmap 画像を TPngImage 画像に変換するのは少し面倒ですが，TPngImage 画像から TBitmap 画像への変換は，以下のように Asssign メソッドで可能です． 


  LPngImg := TPngImage.Create;
  LBitmap := TBitmap.Create;
  try
    LPngImg.LoadFromFile(LImgPath);
    LBitmap.Assign(LPngImg);
    DrawBackGouundBmp(Image1, LPngImg.Width, LPngImg.Height);
    Image1.Canvas.Draw(0, 0, LBitmap);
  finally
    FreeAndNil(LPngImg);
    FreeAndNil(LBitmap);
  end;
end;


TGIFImage 画像の透過色は，次のように，TGIFImage.Bitmap.TransparentColor;で取得できます．
このサンプルは，TBitmap 画像の透過色を，TGIFImage 画像の透過色と同じにします．

 

  LGifImg := TGIFImage.Create;
  LBitmap := TBitmap.Create;
  try
    LGifImg.LoadFromFile(LImgPath);
    LBitmap.Assign(LGifImg);
    LBitmap.TransparentColor := LGifImg.Bitmap.TransparentColor;
    LBitmap.Transparent := True;

    DrawBackGouundBmp(Image1, LGifImg.Width, LGifImg.Height);
    Image1.Canvas.Draw(0, 0, LBitmap);
  finally
    FreeAndNil(LGifImg);
    FreeAndNil(LBitmap);
  end;