如何将 FMX.Graphics.TBitmap 转换为 VCL.Graphics.TBitmap 或 Vcl.Imaging.PngImage.TPngImage？答案

【问题标题】：How can convert FMX.Graphics.TBitmap to VCL.Graphics.TBitmap or Vcl.Imaging.PngImage.TPngImage?如何将 FMX.Graphics.TBitmap 转换为 VCL.Graphics.TBitmap 或 Vcl.Imaging.PngImage.TPngImage？
【发布时间】：2016-08-17 19:25:22
【问题描述】：

如何将 FMX.Graphics.TBitmap 转换为 VCL.Graphics.TBitmap 或 Vcl.Imaging.PngImage.TPngImage？

我的项目中有 FMX 表单和 VCL 表单。

【问题讨论】：

我想你可以保存到内存流，然后加载。但使用Map 获取位图数据，然后以这种方式填充新的 VCL 位图可能更有效。

标签： delphi png delphi-xe8 tbitmap

【解决方案1】：

感谢David Heffernan 和一些搜索我写了这些函数如下。

我先想出不支持Alpha的功能

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，它支持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;

【讨论】：

这是一个极其缓慢的幼稚解决方案。看看delphi-foundations.googlecode.com/svn/trunk/XE2%20book/…
@FreeConsulting 的链接已消失。工作之一 - github.com/bravesoftdz/delphi-foundations/blob/master/…

【解决方案2】：

更正使用矩形图像：

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(j,i);
        Result.Canvas.Pixels[j,i]:=
          RGB(
            TAlphaColorRec(AlphaColor).R,
            TAlphaColorRec(AlphaColor).G,
            TAlphaColorRec(AlphaColor).B);
      end;
    end;
  finally
    b.Unmap(data);
  end;
end;

【讨论】：

请用英文。