Obsługa kamery pod VCL

0

Witam.
Mam problem z obsługą kamery pod vcl-em.
Środowisko Delphi Berlin, kompilacja pod win32.
Zapożyczyłem przykładowy kod ze strony http://docwiki.embarcadero.com/RADStudio/Berlin/en/Video_Capturing

Niestety przeniesienie kodu pod vcl daje access violation w linii kodu:

VideoCamera.SampleBufferToBitmap(FMX.Graphics.TBitmap(Image1.Picture.Bitmap), true);

Czy rzutowanie na FMX.Graphics.TBitmap jest niepoprawne ??

Cały kod:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages,
  System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  FMX.Graphics, FMX.Media,
  Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Image1: TImage;
    Button1: TButton;
    ComboBox1: TComboBox;
    procedure Button1Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    VideoCamera: TVideoCaptureDevice;
    procedure SampleBufferSync;
    procedure SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  if (VideoCamera <> nil) then
  begin
    if (VideoCamera.State = TCaptureDeviceState.Stopped) then
    begin
      VideoCamera.OnSampleBufferReady := SampleBufferReady;
      VideoCamera.StartCapture;
      Button1.Caption := 'STOP';
    end
    else
    begin
      VideoCamera.StopCapture;
      Button1.Caption := 'START';
    end;
  end
  else
  begin
    Caption := 'Video capture devices not available.';
  end;
end;



procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  VideoCamera := TVideoCaptureDevice(TCaptureDeviceManager.Current.GetDevicesByName(ComboBox1.Text));

  if (VideoCamera <> nil) then
  begin
    Button1.Enabled := true;
  end;
end;




procedure TForm1.FormCreate(Sender: TObject);
var
  DeviceList: TCaptureDeviceList;
  i: integer;
begin
  DeviceList := TCaptureDeviceManager.Current.GetDevicesByMediaType(TMediaType.Video);

  for i := 0 to DeviceList.Count - 1 do
  begin
    ComboBox1.Items.Add(DeviceList[i].Name);
  end;
end;



procedure TForm1.FormDestroy(Sender: TObject);
begin
  if VideoCamera <> nil then
    VideoCamera.StopCapture;
end;



procedure TForm1.SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
begin
  TThread.Synchronize(TThread.CurrentThread, SampleBufferSync);
  //Resize the image so that the video is buffered in its original size
  Image1.Width:=Image1.Picture.Width;
  Image1.Height:=Image1.Picture.Height;
end;



procedure TForm1.SampleBufferSync;
begin
 VideoCamera.SampleBufferToBitmap(FMX.Graphics.TBitmap(Image1.Picture.Bitmap), true);
end;



end.

1

Już od dawna nie mam do czynienia z Delphi, więc w razie czego poprawcie mnie.

Po pierwsze, Image1.Picture.Bitmap może nie zawierać referencji do instancji bitmapy. Wszystko dlatego, że Image1.Picture może przechowywać obraz dowolnego formatu. Po drugie, buforowanie obrazu bezpośrednio w TImage jest nieefektywne.


Jeśli chcesz naprawić bieżący kod, to utwórz obiekt bitmapy:

Image1.Picture.Bitmap := TBitmap.Create();

a problematyczną linijkę wymień na poniższą:

VideoCamera.SampleBufferToBitmap(Image1.Picture.Bitmap, True);
0

Dzięki za odpowiedź.

Niestety jawne utworzenie bitmapy przez

Image1.Picture.Bitmap := Tbitmap.Create;

nic nie zmienia :/ dalej jest ten sam błąd.

Do tego wywołanie metody VideoCamera.SampleBufferToBitmap konieczne jest z przekazaniem typu Tbitmap ale z przestrzeni FMX.Graphics.
dlatego rzutuje go przez

FMX.Graphics.TBitmap(Image1.Picture.Bitmap)

Widać RTTI z tym rzutowaniem sobie nie radzi.

0
PrzemysławWiśniewski napisał(a):

Do tego wywołanie metody VideoCamera.SampleBufferToBitmap konieczne jest z przekazaniem typu Tbitmap ale z przestrzeni FMX.Graphics.

W takim razie nie używaj Image.Picture.Bitmap jako bufora docelowego. Stwórz sobie pomocniczy obiekt klasy FMX.Graphics.TBitmap i jego używaj do renderowania klatki obrazu z kamery. Skup się póki co na samym renderowaniu obrazu klatki, a jak już to będzie działało, to wtedy pomyśli się nad renderowaniem interfejsu.

1 użytkowników online, w tym zalogowanych: 0, gości: 1