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

Question

我试图在使用 opencv 处理图像后，在带有 paintbox 的多设备表单上显示用相机拍摄的图像。但是，cvImage2Bitmap returns VCL.Graphics.TBitmap。所以我需要将其转换为 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.

如果您知道任何其他将 iplimage 显示到 paintbox 的有效方法，请告诉我们。

Answer 1

有几种方法可以做到这一点。一种方法是将 VCL 位图写入 TStream，然后将其读入 FMX 位图中。但是，您不能像那样转换其他方式，而且它可能会很慢。我更喜欢使用扫描线在一个和另一个之间进行转换。在我下面的代码中，我使用了 24 位 VCL 位图，因为我发现 Windows API 更喜欢这些（例如 AVIFile32）。两个位图都需要在调用过程之前创建。当然，您需要为 Windows 创建一个 FMX 应用程序并在您的使用中包含 VCL.Graphics。转换为 24 位 VCL 位图时，FMX 位图中的任何透明度都将丢失。

将 24 位 VCL 位图转换为 FMX 位图

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;

将 FMX 位图转换为 24 位 VCL 位图

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

将图像数据直接从一个位图移动到另一个位图会很好，但似乎不是一件容易的事。

相反，最简单的方法（如此处回答VCL.Bitmap To FMX.Bitmap）似乎是将图像保存到内存流并再次加载到 FMX 位图对象中。

这个简单的代码很管用。您需要为将图像数据移动到内存以在新位图中再次加载而付出代价，但为了简单起见似乎是公平的。

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;

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

How to change bitmap from VCL.Graphics.TBitmap to FMX.Graphics.TBitmap

delphi

pascal