1

我正在使用 RAD Studio XE5 上的 Delphi FireMonkey 开发一个必须在 iOS、Android 和 W32/64 上运行的应用程序。我正在尝试访问摄像机以扫描条形码。

我已经VideoCaptureHD使用 USB 网络摄像头在 W32 上运行示例应用程序，但在 Android 上，该应用程序只显示背景颜色，没有来自摄像头的图像。我在该SampleBufferReady方法中添加了一个断点，但它永远不会被调用。

此外，启用捕获按钮表示相机设备在某个级别上被识别。

//---------------------------------------------------------------------------

// This software is Copyright (c) 2012 Embarcadero Technologies, Inc.
// You may only use this software if you are an authorized licensee
// of Delphi, C++Builder or RAD Studio (Embarcadero Products).
// This software is considered a Redistributable as defined under
// the software license agreement that comes with the Embarcadero Products
// and is subject to that software license agreement.

//---------------------------------------------------------------------------
unit CaptureForm;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Objects, FMX.Media, FMX.StdCtrls,
  FMX.Layouts, FMX.ListBox;

type
  TForm1 = class(TForm)
    Image1: TImage;
    CaptureButton: TSpeedButton;
    Layout1: TLayout;
    SaveDialog1: TSaveDialog;
    Ellipse1: TEllipse;
    StopButton: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure CaptureButtonClick(Sender: TObject);
    procedure StopButtonClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    VideoCamera: TVideoCaptureDevice;
    procedure SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
  VideoCamera := TCaptureDeviceManager.Current.DefaultVideoCaptureDevice;
  if VideoCamera <> nil then
  begin
    Ellipse1.AnimateFloat('Opacity', 1, 1.0);
    VideoCamera.OnSampleBufferReady := SampleBufferReady;
    VideoCamera.StartCapture;
  end
  else
  begin
    CaptureButton.Enabled := False;
    Caption := 'Video capture devices not available.';
  end;
end;

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

procedure TForm1.SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
begin
  VideoCamera.SampleBufferToBitmap(Image1.Bitmap, True);
end;

procedure TForm1.StopButtonClick(Sender: TObject);
begin
  if VideoCamera <> nil then
  begin
    if VideoCamera.State = TCaptureDeviceState.Capturing then
    begin
      Ellipse1.AnimateFloat('Opacity', 0, 1.0);
      StopButton.Text := 'Capture';
      VideoCamera.StopCapture;
    end
    else
    begin
      Ellipse1.AnimateFloat('Opacity', 1, 1.0);
      StopButton.Text := 'Stop';
      VideoCamera.StartCapture
    end;
  end;
end;

procedure TForm1.CaptureButtonClick(Sender: TObject);
begin
  if SaveDialog1.Execute then
    Image1.Bitmap.SaveToFile(SaveDialog1.FileName);
end;

end.
4

1 回答 1

0

我在您的应用程序中找不到错误或错误。

您还应该检查 Project->Options->UsesPermisions->Android->Camera 是否为 True。

我做了类似的应用程序并且它有效（公共变量与您的相同）：

procedure TForm1.Button1Click(Sender: TObject);   //starts capturing on click
begin
  VideoCamera.StartCapture;
end;

procedure TForm1.Button2Click(Sender: TObject);   //stops capturing on click
begin
  VideoCamera.StopCapture;
end;

procedure TForm1.Button3Click(Sender: TObject);   //create camera on click
begin
  VideoCamera := TCaptureDeviceManager.Current.DefaultVideoCaptureDevice;
  if VideoCamera <> nil then
  begin
    VideoCamera.OnSampleBufferReady := SampleBufferReady;
  end
  else
  begin
    ShowMessage('Video capture devices not available.');
  end;
end;

procedure TForm1.SampleBufferReady(Sender: TObject; const ATime: TMediaTime); // copy to bitmap works perfect
begin
  VideoCamera.SampleBufferToBitmap(Image1.Bitmap, True);
end;
于 2014-02-26T11:58:09.747 回答