透明ありの PNGファイルの解像度を変更する方法

解決

vram 2024-10-08 16:34:09 No: 151624

透明色ありの PNGファイルの解像度を変更する処理を作りたいのですが
普通に作ると情報が失われます

そこでTPngImageクラスを使って作ってみたのですが思うような結果にはなりません
TPngImageクラスを使うのが間違いなのでしょうか？

サンプル

unit Unit1;

interface

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

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

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  pngf,pngt : TPngImage;
begin
  pngf := TPngImage.Create;
  pngt := TPngImage.Create;
  try
    pngf.LoadFromFile('sample.png');

    pngt.Assign(pngf);
    pngt.SetSize(100,100);
    pngt.Canvas.Brush.Style := bsSolid;
    pngt.Canvas.Brush.Color := pngf.TransparentColor;
    pngt.Canvas.FillRect(Rect(0,0,100,100));
    pngt.Canvas.StretchDraw(Rect(0,0,100,100),pngf);

    pngt.SaveToFile('sample2.png');
  finally
    pngt.Free;
    pngf.Free;
  end;
end;

end.
DelphiXE5、Delphi12.1 VCL Windows10

igy 2024-10-09 13:23:04 No: 151625

関係ないかもしれませんが、

>pngt.SaveToFile('sample2.png');
の前に、
pngt.Transparent := True;
pngt.TransparentColor := pngf.TransparentColor;

を追加した場合、結果は同じですか？

vram 2024-10-09 14:35:39 No: 151626

レスありがとうございます
試したところ
pngt.TransparentColor := pngf.TransparentColor;
の行で
ChangeTransparent
(メッセージ各ピクセルに対するアルファ値 (COLOR_RGBALPHA と COLOR_GRAYSCALEALPHA)を含む PNG 画像で透過色のビット設定は許可されていません
というエラーが出ます

igy 2024-10-10 00:19:20 No: 151627

期待どおりになるか、わかりませんが、

procedure TForm1.Button1Click(Sender: TObject);
var
  pngf,pngt : TPngImage;
  bmp: TBitmap;
begin
  pngf := TPngImage.Create;
  pngt := TPngImage.Create;
  bmp := TBitmap.Create;
  try
    pngf.LoadFromFile('sample.png');

    bmp.SetSize(100,100);
    bmp.Canvas.Brush.Style := bsSolid;
    bmp.Canvas.Brush.Color := pngf.TransparentColor;
    bmp.Canvas.FillRect(Rect(0,0,100,100));
    bmp.Canvas.StretchDraw(Rect(0,0,100,100),pngf);

    bmp.Transparent := True;
    bmp.TransparentColor := pngf.TransparentColor;
    pngt.Assign(bmp);

    pngt.SaveToFile('sample2.png');
  finally
    pngt.Free;
    pngf.Free;
    bmp.Free;
  end;
end;

としてみたら、いかがですか？

vram 2024-10-10 08:53:40 No: 151628

サンプルありがとうございます
試したところ元々透明だったところは透明に、透明ではないところは元の色となっているのですが
StretchDrawでサイズを変更するときに滑らかに見せようとする部分も透明となり（この機能は必要）
元の形からは遠い物となってしまいます

ここに行き着くまでに知ったこと、学んだことを説明させて頂くと

1.Delphi VCLのTCanvasは互換性優先のため透明のPNG 正確にはアルファチャンネル付きPNGがうまく扱えない
2.TBitmapは32bitの設定でアルファチャンネルが追加されたがCanvas経由だと互換性優先のためアルファチャンネルが逆になったりする
3.この問題を解決するため有志が作った「Graphics32」というライブラリがあり専用のTCanvas32を使えばこの問題は解決する
※ただしGraphics32は巨大な上、日本語マニュアルは無い　今回の件で使うのは負担が大きすぎる

FMXでは試したことはないですが、VCLでこれぐらいのこと簡単にできるだろと思ってたら
なかなか解決しないので質問させて頂きました

mam 2024-10-10 10:32:26 No: 151629

PNGファイルは大きく3種類あるようですが、
①非透過性
②ビット透過性
③アルファ値（アルファチャネル）付き透過性

今般の場合は③の場合のPNGファイルのようですね。
アルゴリズムがニアレストネイバー（近接近傍法）で良いのであれば、以下ソースコードでは如何でしょうか。
バイキュービック法が良いのであれば、以下URLを参考にして、ソースコード作成する必要があります。
https://mam-mam.net/delphi/bicubic.html
（↑アルファチャネル付きの透過型画像は考慮していないので。）

procedure TForm1.Button1Click(Sender: TObject);
Type
  TRGB=record B,G,R:Byte; end;
  TRGBArr=array[0..30000] of TRGB;
  PRGBArr=^TRGBArr;
  TRGBArrArr=array[0..30000] of PRGBArr;
  TAlphaArrArr=array[0..30000] of pByteArray;
var Pngf,Pngt:TPngImage;
    x,y:Integer;
    rate:Single;
    RGBf,RGBt:TRGBArrArr;
    Alphaf,Alphat:TAlphaArrArr;
begin
  pngf := TPngImage.Create;
  try
    pngf.LoadFromFile('..\..\f2.png');
    if Pngf.TransparencyMode=ptmPartial then
    begin
      rate:=2;//2倍に拡大する場合
      pngt := TPngImage.Create;
      try
        Pngt.Assign(Pngf);
        Pngt.SetSize(Trunc(Pngf.Width*rate),Pngf.Height*Trunc(rate));

        for y := 0 to pngf.Height-1 do
        begin
          RGBf[y]:=pngf.Scanline[y];
          Alphaf[y]:=pngf.AlphaScanline[y];
        end;
        for y := 0 to pngt.Height-1 do
        begin
          RGBt[y]:=pngt.Scanline[y];
          Alphat[y]:=pngt.AlphaScanline[y];
        end;
        for y := 0 to pngt.Height-1 do
        begin
          for x := 0 to pngt.Width-1 do
          begin
            RGBt[y][x].R:=RGBf[Trunc(y/rate)][Trunc(x/rate)].R;
            RGBt[y][x].G:=RGBf[Trunc(y/rate)][Trunc(x/rate)].G;
            RGBt[y][x].B:=RGBf[Trunc(y/rate)][Trunc(x/rate)].B;
            Alphat[y][x]:=Alphaf[Trunc(y/rate)][Trunc(x/rate)];
          end;
        end;
        pngt.SaveToFile('..\..\t.png');
      finally
        pngt.Free;
      end;
    end
    else if Pngf.TransparencyMode=ptmBit then
      showmessage('PNG画像はビット透過サポートでアルファ値は含んでいない')
    else //Pngf.TransparencyMode=ptmNoneの場合

      showmessage('PNG 画像は透過性をサポートしていません');
  finally
    pngf.Free;
  end;
end;

vram 2024-10-10 11:07:25 No: 151630

mam 様へ
サンプルを試したところうまくいきました
拡大率が整数ではないのでそこだけ自力で対応すればなんとかなりそうです

igy様へ
サンプルを頂きありがとうございます
今回はmam 様のコードを採用させて頂きます

ありがとうございました

mam URL 2024-10-15 09:34:58 No: 151634

一部ソースコードにミスがありました。誠に申し訳ございません。

誤：
Pngt.SetSize(Trunc(Pngf.Width*rate),Pngf.Height*Trunc(rate));

正：
PngT.SetSize(Trunc(PngF.Width*Rate),Trunc(PngF.Height*Rate));

以下URLに正しいソースコードを置きました。
https://mam-mam.net/delphi/vcl_tpngimage.html