3

How a FMX.Graphics.TBitmap can be converted to VCL.Graphics.TBitmap or Vcl.Imaging.PngImage.TPngImage?

I have both FMX form and VCL form in my project.

Loghman
  • 1,500
  • 1
  • 14
  • 30
  • 1
    I suppose that you could save to a memory stream, and then load. But it might be more efficient to use `Map` to obtain the bitmap data, and then populate a new VCL bitmap that way. – David Heffernan Apr 24 '16 at 12:51

2 Answers2

2

Thanks to David Heffernan and some search I wrote these functions as following.

I first come up with the function that doesn't support 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;

and I wrote the second function to convert FMX.Graphics.TBitmap to Vcl.Imaging.PngImage.TPngImage and it supports 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;
Community
  • 1
  • 1
Loghman
  • 1,500
  • 1
  • 14
  • 30
  • This is extremely slow naive solution. Take look https://delphi-foundations.googlecode.com/svn/trunk/XE2%20book/13.%20Native%20APIs/Taking%20a%20screenshot/ScreenshotForm.pas – Free Consulting Apr 25 '16 at 00:12
  • @FreeConsulting's link had gone. Working one - https://github.com/bravesoftdz/delphi-foundations/blob/master/XE2%20book/13.%20Native%20APIs/Taking%20a%20screenshot/ScreenshotForm.pas – Serhii Kheilyk May 01 '18 at 12:25
0

Correction to work with rectangular images:

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;
Robledo Fortuna
  • 1