如何將位圖從VCL.Graphics.TBitmap更改為FMX.Graphics.TBitmap

我試圖在用opencv處理它后，在一個帶有paintbox的多設備表單上顯示用相機拍攝的影像。但是，cvImage2Bitmap 回傳 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 的有效方法，請告訴我們。

uj5u.com熱心網友回復：

將影像資料直接從一個位圖移動到另一個位圖會很好，但似乎不是一件容易的事。

相反，最簡單的方法（正如這里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;

uj5u.com熱心網友回復：

有幾種方法可以做到這一點。一種方法是將 VCL 位圖寫入 TStream，然后將其讀入 FMX 位圖。但是，您不能像那樣轉換其他方式，它可能會很慢。我更喜歡使用 Scanlines 在一個和另一個之間進行轉換。在下面的代碼中，我使用 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;

標籤：德尔福 帕斯卡

上一篇：TEdgeBrowser.Navigate加載失敗，未引發錯誤

下一篇：從周數中檢索年份