delphi - FMX.Graphics.TBitmap を VCL.Graphics.TBitmap または Vcl.Imaging.PngImage.TPngImage に変換するにはどうすればよいですか?

Question

FMX.Graphics.TBitmap を VCL.Graphics.TBitmap または Vcl.Imaging.PngImage.TPngImage に変換するにはどうすればよいですか?

プロジェクトに FMX フォームと VCL フォームの両方があります。

Answer 1

David Heffernanといくつかの検索のおかげで、 これらの関数を次のように記述しました。

アルファに対応していない機能を最初に思いついた

function ConvertFmxBitmapToVclBitmap(b:FMX.Graphics.TBitmap):Vcl.Graphics.TBitmap;
var
  data:FMX.Graphics.TBitmapData;
  i,j:Integer;
  AlphaColor:TAlphaColor;
begin
  Result:=VCL.Graphics.TBitmap.Create;
  Result.SetSize(b.Width,b.Height);
  if(b.Map(TMapAccess.Readwrite,data))then
  try
    for i := 0 to data.Height-1 do begin
      for j := 0 to data.Width-1 do begin
        AlphaColor:=data.GetPixel(i,j);
        Result.Canvas.Pixels[i,j]:=
          RGB(
            TAlphaColorRec(AlphaColor).R,
            TAlphaColorRec(AlphaColor).G,
            TAlphaColorRec(AlphaColor).B);
      end;
    end;
  finally
    b.Unmap(data);
  end;
end;

FMX.Graphics.TBitmapをVcl.Imaging.PngImage.TPngImageに変換する 2 番目の関数を作成し、Alpha をサポートしています。

function ConvertFmxBitmapToPng(b:FMX.Graphics.TBitmap):Vcl.Imaging.PngImage.TPngImage;
var
  data:FMX.Graphics.TBitmapData;
  i,j:Integer;
  AlphaColor:TAlphaColor;
  AlphaLine:VCL.Imaging.PngImage.pByteArray;
begin
  result:=TPngImage.CreateBlank(COLOR_RGBALPHA, 8, b.Width, b.Height);;
  if(b.Map(TMapAccess.Readwrite,data))then
  try
    for i := 0 to data.Height-1 do begin
      AlphaLine:=Result.AlphaScanline[i];
      for j := 0 to data.Width-1 do begin
        AlphaColor:=data.GetPixel(j,i);
        AlphaLine^[j]:=TAlphaColorRec(AlphaColor).A;
        Result.Pixels[j,i]:=
          RGB(
            TAlphaColorRec(AlphaColor).R,
            TAlphaColorRec(AlphaColor).G,
            TAlphaColorRec(AlphaColor).B);
      end;
    end;
  finally
    b.Unmap(data);
  end;
end;