如何将 bitmap 从 VCL.Graphics.TBitmap 更改为 FMX.Graphics.TBitmap

Question

I'm trying to show an image taken with a camera on a multi-device form with paintbox after processing it with opencv. However, cvImage2Bitmap returns VCL.Graphics.TBitmap. So I need to convert this to FMX.Graphics.TBitmap.

unit xml_cam2;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, VCL.Graphics, FMX.Dialogs, FMX.ScrollBox,
  FMX.Memo, FMX.Objects, FMX.Controls.Presentation, FMX.StdCtrls,
  ocv.highgui_c,
  ocv.core_c,
  ocv.core.types_c,
  ocv.imgproc_c,
  ocv.imgproc.types_c,
  ocv.utils;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    PaintBox1: TPaintBox;
    Memo1: TMemo;
    procedure PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
    procedure FormCreate(Sender: TObject);
  private
    capture: pCvCapture;
    frame: pIplImage;
    procedure OnIdle(Sender: TObject; var Done: Boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation


var
  Bitmap, PaintBoxBitmap: FMX.Graphics.TBitmap;

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
  capture := cvCreateCameraCapture(CV_CAP_ANY);
  if Assigned(capture) then
    Application.OnIdle := OnIdle;
end;

procedure TForm1.OnIdle(Sender: TObject; var Done: Boolean);
begin
  if Assigned(capture) then
  begin
    frame := cvQueryFrame(capture);
    if Assigned(frame) then
    begin
      Bitmap := cvImage2Bitmap(frame);
      //cvImage2Bitmap returns VCL.Graphics.TBitmap
    end;
  end;

  Memo1.Lines.Add(IntToStr(Bitmap.Width));
  Memo1.Lines.Add(IntToStr(Bitmap.Height));

  if (PaintBoxBitmap = nil) then
    PaintBoxBitmap := FMX.Graphics.TBitmap.Create;
  PaintBoxBitmap.Assign(Bitmap);
  Invalidate;
  Bitmap.Free;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
begin
  if Assigned(PaintBoxBitmap) then
    PaintBox1.Canvas.DrawBitmap(PaintBoxBitmap, PaintBox1.ClipRect, PaintBox1.ClipRect, 1);
    Memo1.Lines.Add('b');
end;

end.

If you know any other efficient way to show iplimage to paintbox, please let us know.

Answer 1

There are a couple of ways to do this. One way is to write the VCL bitmap to a TStream and then read it into the FMX bitmap. However, you can't convert the other way like that and it may be quite slow. I prefer to use Scanlines to convert between one and the other. In my code below I'm using 24 bit VCL bitmaps because I've found that the Windows API prefers these (AVIFile32 for example). Both bitmaps need to be created before calling the procedures. Of course you need to be creating an FMX application for Windows and include VCL.Graphics in your uses. Any transparency in the FMX bitmap will be lost when converting to a 24 bit VCL bitmap.

Convert 24 bit VCL bitmap to FMX bitmap

procedure VCLtoFMX_Bitmap(const VCLBmp : VCL.Graphics.TBitmap ; out FMXBmp : FMX.Graphics.TBitmap);
var
  bData : TBitmapData;
  x, y : Integer;
  pfmxbyte, pvclbyte : PByte;
begin
  VCLBmp.PixelFormat := pf24bit;
  FMXBmp.SetSize(VCLBmp.Width, VCLBmp.Height);
  FMXBmp.Map(TMapAccess.ReadWrite, bdata);

  try
    for y := 0 to FMXBmp.Height - 1 do begin
      pfmxbyte := bdata.GetScanline(y);
      pvclbyte := VCLBmp.Scanline[y];
      for x := 0 to FMXBmp.Width - 1 do begin
        pfmxbyte^ := pvclbyte^; Inc(pvclbyte); Inc(pfmxbyte);
        pfmxbyte^ := pvclbyte^; Inc(pvclbyte); Inc(pfmxbyte);
        pfmxbyte^ := pvclbyte^; Inc(pvclbyte); Inc(pfmxbyte);
        pfmxbyte^ := $FF; Inc(pfmxbyte); // Full opacity
      end;
    end;
  finally
    FMXBmp.Unmap(bdata);
  end;
end;

Convert FMX bitmap to 24 bit VCL bitmap

procedure FMXtoVCL_Bitmap(const FMXBmp : FMX.Graphics.TBitmap ; out VCLBmp : VCL.Graphics.TBitmap);
var
  bData : TBitmapData;
  x, y : Integer;
  pfmxbyte, pvclbyte : PByte;
begin
  VCLBmp.PixelFormat := pf24bit;
  VCLBmp.SetSize(FMXBmp.Width, FMXBmp.Height);
  FMXBmp.Map(TMapAccess.Read, bdata);

  try
    for y := 0 to FMXBmp.Height - 1 do begin
      pfmxbyte := bdata.GetScanline(y);
      pvclbyte := VCLBmp.Scanline[y];
      for x := 0 to FMXBmp.Width - 1 do begin
        pvclbyte^ := pfmxbyte^; Inc(pvclbyte); Inc(pfmxbyte);
        pvclbyte^ := pfmxbyte^; Inc(pvclbyte); Inc(pfmxbyte);
        pvclbyte^ := pfmxbyte^; Inc(pvclbyte); Inc(pfmxbyte, 2);
      end;
    end;
  finally
    FMXBmp.Unmap(bdata);
  end;
end;

Answer 2

It would be nice to move image data directly from one bitmap to the other, but doesn't seems to be an easy task.

Instead, the simplest way ( as it was answered here VCL.Bitmap To FMX.Bitmap ) seems to be to save image to a memory stream and load again in FMX bitmap object.

This simple code just works. You pay the penalty for moving image data to memory to load again in the new bitmap, but seems fair in exchange for simplicity.

procedure TForm1.FormCreate(Sender: TObject);
var
  ms : TMemoryStream;
begin
  ms := TMemoryStream.Create;
  try
    VCL_bmp := VCL.Graphics.TBitmap.Create;
    try
      VCL_bmp.LoadFromFile('file.bmp');
      VCL_bmp.SaveToStream(ms);
      ms.Seek(0, soFromBeginning);
    finally
      FreeAndNil(VCL_bmp);
    end;

    FMX_bmp := FMX.Graphics.TBitmap.Create();
    try
      FMX_bmp.LoadFromStream(ms);

      ... do something with the image ...
    finally
      FreeAndNil(FMX_bmp);
    end;
  finally
    FreeAndNil(ms);
  end;
end;