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;