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;