透明色ありの 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
関係ないかもしれませんが、
>pngt.SaveToFile('sample2.png');
の前に、
pngt.Transparent := True;
pngt.TransparentColor := pngf.TransparentColor;
を追加した場合、結果は同じですか？
レスありがとうございます
試したところ
pngt.TransparentColor := pngf.TransparentColor;
の行で
ChangeTransparent
(メッセージ各ピクセルに対するアルファ値 (COLOR_RGBALPHA と COLOR_GRAYSCALEALPHA)を含む PNG 画像で透過色のビット設定は許可されていません
というエラーが出ます
期待どおりになるか、わかりませんが、
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;
としてみたら、いかがですか？
サンプルありがとうございます
試したところ元々透明だったところは透明に、透明ではないところは元の色となっているのですが
StretchDrawでサイズを変更するときに滑らかに見せようとする部分も透明となり（この機能は必要）
元の形からは遠い物となってしまいます
ここに行き着くまでに知ったこと、学んだことを説明させて頂くと
1.Delphi VCLのTCanvasは互換性優先のため透明のPNG 正確にはアルファチャンネル付きPNGがうまく扱えない
2.TBitmapは32bitの設定でアルファチャンネルが追加されたがCanvas経由だと互換性優先のためアルファチャンネルが逆になったりする
3.この問題を解決するため有志が作った「Graphics32」というライブラリがあり専用のTCanvas32を使えばこの問題は解決する
※ただしGraphics32は巨大な上、日本語マニュアルは無い 今回の件で使うのは負担が大きすぎる
FMXでは試したことはないですが、VCLでこれぐらいのこと簡単にできるだろと思ってたら
なかなか解決しないので質問させて頂きました
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;
mam 様へ
サンプルを試したところうまくいきました
拡大率が整数ではないのでそこだけ自力で対応すればなんとかなりそうです
igy様へ
サンプルを頂きありがとうございます
今回はmam 様のコードを採用させて頂きます
ありがとうございました
一部ソースコードにミスがありました。誠に申し訳ございません。
誤：
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