本投稿はDelphi AdventCalender 2025 #19の記事です。
この記事は，Delphi13でコードを書き，Windows11で動作を確認しています。
はじめに
VCLアプリケーションで生成したアルファレイヤ付きのTBitmapをTPngImageを使ってPNGファイルに保存しようとしました。その時書いたコードは以下のものです。
ABitmap:TBitmapにアルファレイヤ付きのビットマップが格納されています。PixelFormatはpf32bitで，AlphaFormatはafDefinedです。
uses
Vcl.Imaging.pngimage;
var
LPng: TPngImage;
begin
LPng := TPngImage.Create;
LPng.Assign(ABitmap);
LPng.CompressionLevel := 9; // PNGの圧縮率
LPng.SaveToFile(APngFileName);
LPng.Free;
end;
しかし，アルファレイアが適用されませんでした。
念のため，ABitmapをBMPで保存してみるとアルファレイヤがあることを確認できました。
そこで，アルファレイヤ付きのBitmapをTPngImageで保存する記事を探したのですが，透過PNGをアルファレイヤ付きのBitmapに保存する方法しか見つけることができませんでしたので，自前で書くことにしました。（もしも存在したらすいません，，）
KP.GraphUtils
TBitmapのScanlineを使います。PixelFormatはpf32bitの場合，ピクセル情報は，B G R A のByteで記録されています。
一方，TPngImageのScanlineは，B G RのByteのみで，アルファレイヤの情報は，AlphaScanlineに格納されています。
そこで，TPngImage.CreateBlankで，アルファレイヤを持つ8ビットの画像を生成して，ScanlineとAlphaScanlineを使ってデータを書き込むことにしました。
なお，AlphaScanlineはVcl.Imaging.pngImage.pByteArrayで返され，その長さは[word]で定義されています。これは[0..65535]なので，ポインタで返されるScanlineをキャストする配列も同じサイズにしています。
追記: 初稿ではAlphaScanlineはSystem.SysUtils.PByteArrayが返されその範囲は[0..32767]であると書いていました。System.SysUtils.PByteArrayの範囲は正しいのですが，AlphaScanlineはVcl.Imaging.pngImage.pByteArrayですので[word]すなわち[0..65535]となります。
QiitaにはBMPファイルを貼り付けられないので，RGBとマスクのPNGファイルを読み込んで合成するおまけの関数BitmapAddMaskも作ってみました。こちらはpf24bitのABitmapのRGBとMBitmapのRをマスクにしたpf32bitのTBitmapを返します。
※ このコードはVCLでしか使えないので，条件指令で挟み込んでいます。
KP.GraphUtils.pas
unit KP.GraphUtils;
(*
2025/12/16 VCL用 アルファレイヤを持つpf32bit BitmapをPNGファイルに保存
LICENSE
Copyright (c) 2025 Yuzuru Kato
Released under the MIT license
http://opensource.org/licenses/mit-license.php
*)
interface
{$IFDEF FRAMEWORK_VCL}
uses
Vcl.Graphics, Vcl.Imaging.pngimage;
// pf24bitのABitmapのRGBとMBitmapのRをマスクにしたpf32bitのTBitmapを返す
function BitmapAddMask(ABitmap, MBitmap: TBitmap):TBitmap;
// アルファレイヤを持つpf32bit BitmapをPNGファイルに保存する
procedure BitmapSaveAsPng(ABitmap: TBitmap; APngFileName:string;
ACompressionLevel: TCompressionLevel=9);
{$ENDIF}
implementation
{$IFDEF FRAMEWORK_VCL}
type
TRGB = record
R,G,B:byte;
end;
TRGBA = record
R,G,B,A:byte;
end;
TRGBAArray = array[word] of TRGBA;
pRGBAArray = ^TRGBAArray;
TRGBArray = array[word] of TRGB;
pRGBArray = ^TRGBArray;
// pf24bitのABitmapのRGBとMBitmapのRをマスクにしたpf32bitのTBitmapを返す
function BitmapAddMask(ABitmap, MBitmap: TBitmap):TBitmap;
var
ResultAr: pRGBAArray;
ABitmapAr: pRGBArray;
MBitmapAr: pRGBArray;
x, y, W, H: Integer;
begin
W := ABitmap.Width;
H := ABitmap.Height;
Result := TBitmap.Create;
try
Result.PixelFormat := pf32bit;
Result.AlphaFormat := afDefined;
Result.SetSize(W, H);
for y:=0 to H-1 do begin
ResultAr := Result.ScanLine[Y];
ABitmapAr := ABitmap.Scanline[Y];
MBitmapAr := MBitmap.Scanline[Y];
for x:=0 to W-1 do begin
ResultAr^[x].R := ABitmapAr^[x].R;
ResultAr^[x].G := ABitmapAr^[x].G;
ResultAr^[x].B := ABitmapAr^[x].B;
ResultAr^[x].A := MBitmapAr^[x].R;
end;
end;
finally
end;
end;
// アルファレイヤを持つpf32bit BitmapをPNGファイルに保存する
procedure BitmapSaveAsPng(ABitmap: TBitmap; APngFileName:string;
ACompressionLevel: TCompressionLevel=9);
var
LPng: TPngImage;
x, y, W, H: Integer;
RGBAAr: pRGBAArray;
PngRGBAr: pRGBArray;
PngALPAr: pByteArray;
begin
if (ABitmap.PixelFormat=pf32bit)and(ABitmap.AlphaFormat<>afIgnored) then begin
W := ABitmap.Width;
H := ABitmap.Height;
LPng := TPngImage.CreateBlank(COLOR_RGBALPHA, 8, W, H);
try
if ABitmap.AlphaFormat=afPremultiplied then begin
for y:=0 to H-1 do begin
RGBAAr := ABitmap.Scanline[y];
PngRGBAr := LPng.Scanline[y];
PngALPAr := LPng.AlphaScanline[y];
for x:=0 to W-1 do begin
PngRGBAr^[x].B := RGBAAr^[x].B;
PngRGBAr^[x].G := RGBAAr^[x].G;
PngRGBAr^[x].R := RGBAAr^[x].R;
PngALPAr^[x] := RGBAAr^[x].A;
end;
end;
end else begin
for y:=0 to H-1 do begin
RGBAAr := ABitmap.Scanline[y];
PngRGBAr := LPng.Scanline[y];
PngALPAr := LPng.AlphaScanline[y];
for x:=0 to W-1 do begin
PngRGBAr^[x].B := trunc(RGBAAr^[x].B*(RGBAAr^[x].A/255));
PngRGBAr^[x].G := trunc(RGBAAr^[x].G*(RGBAAr^[x].A/255));
PngRGBAr^[x].R := trunc(RGBAAr^[x].R*(RGBAAr^[x].A/255));
PngALPAr^[x] := RGBAAr^[x].A;
end;
end;
end;
LPng.CompressionLevel := ACompressionLevel;
LPng.SaveToFile(APngFileName);
finally
LPng.Free;
end;
end else begin
LPng := TPngImage.Create;
LPng.Assign(ABitmap);
LPng.CompressionLevel := ACompressionLevel;
LPng.SaveToFile(APngFileName);
LPng.Free;
end;
end;
{$ENDIF}
end.
テストプログラム
KP.GraphUtilsを使ったテストプログラムを書いてみます。
フォームの設計
VCLアプリケーションを新規作成して，以下のように，Button1: TButton と OpenDialog1: TOpenDialog と SaveDialog1: TSaveDialog を配置します。
テストコード
Button1のクリックイベントを以下のように書きます。
・・・
uses
Vcl.Imaging.pngimage,
KP.GraphUtils;
procedure TForm1.Button1Click(Sender: TObject);
var
LPng: TPngImage;
LBitmap: TBitmap;
LBitmapRGB: TBitmap;
LBitmapMSK: TBitmap;
begin
LPng:=TPngImage.Create;
OpenDialog1.Title := 'PNGファイルを指定してください';
OpenDialog1.Filter := 'PNGファイル|*.png';
OpenDialog1.FileName := '*_RGB.png';
if OpenDialog1.Execute then begin
LPng.LoadFromFile(OpenDialog1.FileName);
LBitmapRGB := TBitmap.Create;
LBitmapRGB.Assign(LPng);
OpenDialog1.Title := 'PNG マスクファイルを指定してください';
OpenDialog1.FileName := '*_MSK.png';
if OpenDialog1.Execute then begin
LPng.LoadFromFile(OpenDialog1.FileName);
LBitmapMSK := TBitmap.Create;
LBitmapMSK.Assign(LPng);
LBitmap:=BitmapAddMask(LBitmapRGB, LBitmapMSK);
LBitmapMSK.Free;
SaveDialog1.Title := '保存するPNGファイルを指定してください';
SaveDialog1.Filter := 'PNGファイル|*.png';
SaveDialog1.FileName := '*.png';
if SaveDialog1.Execute then begin
BitmapSaveAsPng(LBitmap, SaveDialog1.FileName, 9);
end;
LBitmap.Free;
end;
LBitmapRGB.Free;
end;
LPng.Free;
end;
・・・
テストで利用する画像
テスト用の画像を用意しました。以下の二つをダウンロードしてください。
画像ファイル (IMG_7525_RGB.pngで保存しておくと読み出しやすいです)
マスクファイル(IMG_7525_MSK.pngで保存しておくと読み出しやすいです)
実行する
Button1をクリックして，最初に画像ファイルを指定し，次にマスクファイルを指定し，保存するファイルを指定すると以下のようなPNGファイルが出力できるはずです。
※ Qiitaの仕様で，透過PNGが適切に表示されないかもしれません。このPNGファイルをダウンロードすると透過であることが確認できると思います。
謝辞
この記事やコードを書くにあたり，以下のサイトを参考にしました。この場を借りて感謝します。
- DelphiでTPngImageを使った透過PNG画像の拡大・縮小と圧縮｜アルファチャンネル対応のサンプルコード
https://mam-mam.net/delphi/vcl_tpngimage.html